Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
11ea707bbe | ||
|
|
506921214d | ||
|
|
9de77699f9 | ||
|
|
f0807a8306 | ||
|
|
3ce0003c9e | ||
|
|
51d8bb69dd | ||
|
|
c3ac079e14 | ||
|
|
ad3340d82a | ||
|
|
978a1585c8 | ||
|
|
4337f29d0a | ||
|
|
a587bab1c9 | ||
|
|
1b13f4c39b | ||
|
|
e61fdee14c | ||
|
|
9b0e692a8f | ||
|
|
70723dfe68 | ||
|
|
10fbddd2a6 | ||
|
|
963f55cc01 | ||
|
|
123357c448 | ||
|
|
0b6ed4c0cc | ||
|
|
004c89f416 | ||
|
|
d4ff35a5f9 | ||
|
|
f4448302e2 | ||
|
|
348ee6dc79 | ||
|
|
604097ee1c | ||
|
|
3a7ffb24ee | ||
|
|
60edbba15d | ||
|
|
12ed97b398 | ||
|
|
bd6571bbf5 | ||
|
|
c15c945262 | ||
|
|
5f1bf3785c | ||
|
|
45bb7e668c | ||
|
|
c268f27308 | ||
|
|
62551dc6c9 | ||
|
|
12356984fc | ||
|
|
223cdd7860 | ||
|
|
9e8018c98e | ||
|
|
0e708c5ee3 | ||
|
|
a66d6993cd | ||
|
|
328eac87b0 | ||
|
|
0e46850a65 | ||
|
|
5da0eb0f6e | ||
|
|
8c037a9a35 | ||
|
|
4e0384d645 | ||
|
|
117ef08c23 | ||
|
|
e67b4b265c | ||
|
|
4dbfac1f5e | ||
|
|
956cd12e5b | ||
|
|
af92eed006 | ||
|
|
f904d3e991 | ||
|
|
f51e695a2a | ||
|
|
e65f5d6f0a | ||
|
|
b48e77a4b3 | ||
|
|
bfa0baf51e | ||
|
|
c5f8a31bd0 | ||
|
|
66cc08fd87 | ||
|
|
b0fc9065f5 | ||
|
|
ec363be888 | ||
|
|
eda22e02db | ||
|
|
8d5664c7ef | ||
|
|
7e8ba692f7 | ||
|
|
3e418271c7 | ||
|
|
c3b3c56322 | ||
|
|
f7b5428c60 | ||
|
|
ef75910c0e | ||
|
|
6d0efb08f7 | ||
|
|
3ca1685044 | ||
|
|
aa1302c1bb | ||
|
|
14334122bc | ||
|
|
c88c8f66f3 | ||
|
|
0ba0d8e030 | ||
|
|
db3f388006 | ||
|
|
5b8568f811 | ||
|
|
d33d47afd2 | ||
|
|
5c517b8093 | ||
|
|
58063f147d | ||
|
|
8f5da92a45 | ||
|
|
88e8930aff | ||
|
|
2e7ab78f7e | ||
|
|
a8b8256385 | ||
|
|
501dd30a0b | ||
|
|
8512ea129a | ||
|
|
9c8200fb78 | ||
|
|
d5378cca9f | ||
|
|
06aaf41ef0 | ||
|
|
402dfade65 | ||
|
|
217fdbd1e7 | ||
|
|
a895a77418 | ||
|
|
91185e5ec3 | ||
|
|
989d52b7f7 | ||
|
|
b25ec915b9 | ||
|
|
064f1099e3 | ||
|
|
b7d6da07b0 | ||
|
|
f481f9d4e7 | ||
|
|
fdb4093ad6 | ||
|
|
0bbcdd7f4b | ||
|
|
71056bc2ed | ||
|
|
88cdde59ce | ||
|
|
910c1afb86 | ||
|
|
39ce9b2da4 | ||
|
|
cae3f191a8 | ||
|
|
47605fd33e | ||
|
|
4de600d91a |
No files matched your search
@@ -11,23 +11,25 @@
|
|||||||
The future of IRC bots is here! Xelhua gives to you, Auto 3.0, a new version of
|
The future of IRC bots is here! Xelhua gives to you, Auto 3.0, a new version of
|
||||||
the popular Auto IRC bot.
|
the popular Auto IRC bot.
|
||||||
|
|
||||||
In this alpha5 release, we have added:
|
In this alpha7 release, we have added:
|
||||||
|
|
||||||
* LinkTitle module for returning the page title of links sent to a channel.
|
* Support for multiple configuration files using bin/auto -c=FILENAME. See
|
||||||
* Added core command MODLIST.
|
bin/auto -h for details.
|
||||||
* Added SEARCH and MORE to QDB. Amount of results returned at a time with
|
* Added network-wide user tracking through Core::IRC::Users.
|
||||||
qdb_search_resnum in the config.
|
|
||||||
|
|
||||||
Bug fixes:
|
Bug fixes:
|
||||||
|
|
||||||
* Fixed a bug when viewing non-existent quotes.
|
* Fixed a bug where a CAP entry for a network was not recreated on a reconnect.
|
||||||
* SEVERE: Fixed a bug that caused rehash to fail.
|
* Fixed a bug where incoming PART's from ourselves were not parsed.
|
||||||
|
* Fixed a bug in UNO where rehashing during a game caused a crash.
|
||||||
|
* Fixed a bug where appropriate data was not cleared after a disconnect.
|
||||||
|
* Fixed a bug where Vim modelines were in an incorrect spot in modules.
|
||||||
|
|
||||||
Incompatibilities:
|
Incompatibilities:
|
||||||
|
|
||||||
None
|
* Many API changes - Minimum version bumped to 3.0.0a7.
|
||||||
|
|
||||||
We thank you for choosing Auto. Please remember that he is still in early
|
We thank you for choosing Auto. Please remember that he is still in mid-
|
||||||
development stages. But we hope we've piqued your interest, as Auto's upcoming
|
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
|
module repository will allow modules to be created by anyone and uploaded
|
||||||
there for everyone to use.
|
there for everyone to use.
|
||||||
@@ -35,4 +37,4 @@ there for everyone to use.
|
|||||||
Auto's goal is to create an efficient, stable and highly customizable IRC bot
|
Auto's goal is to create an efficient, stable and highly customizable IRC bot
|
||||||
in Perl. To offer an alternative to other platforms.
|
in Perl. To offer an alternative to other platforms.
|
||||||
|
|
||||||
Enjoy Auto 3.0.0 Alpha 5!
|
Enjoy Auto 3.0.0 Alpha 7!
|
||||||
@@ -50,4 +50,4 @@ else
|
|||||||
echo "Usage: auto (start|stop|rehash|status|getmodules)"
|
echo "Usage: auto (start|stop|rehash|status|getmodules)"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -14,6 +14,7 @@ use English qw(-no_match_vars);
|
|||||||
use Sys::Hostname;
|
use Sys::Hostname;
|
||||||
use IO::Socket;
|
use IO::Socket;
|
||||||
use IO::Select;
|
use IO::Select;
|
||||||
|
use Getopt::Long;
|
||||||
use DBI;
|
use DBI;
|
||||||
use Class::Unload;
|
use Class::Unload;
|
||||||
use FindBin qw($Bin);
|
use FindBin qw($Bin);
|
||||||
@@ -21,6 +22,10 @@ our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::Pr
|
|||||||
BEGIN {
|
BEGIN {
|
||||||
unshift @INC, "$Bin/../lib";
|
unshift @INC, "$Bin/../lib";
|
||||||
|
|
||||||
|
open my $gitfh, '<', "$Bin/../.git/refs/heads/indev";
|
||||||
|
our $VERGITREV = substr readline $gitfh, 0, 7;
|
||||||
|
close $gitfh;
|
||||||
|
|
||||||
# Set version information.
|
# Set version information.
|
||||||
use constant { ## no critic qw(ValuesAndExpressions::ProhibitConstantPragma)
|
use constant { ## no critic qw(ValuesAndExpressions::ProhibitConstantPragma)
|
||||||
NAME => 'Auto IRC Bot',
|
NAME => 'Auto IRC Bot',
|
||||||
@@ -28,7 +33,6 @@ BEGIN {
|
|||||||
SVER => 0,
|
SVER => 0,
|
||||||
REV => 0,
|
REV => 0,
|
||||||
RSTAGE => 'd',
|
RSTAGE => 'd',
|
||||||
GR => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7
|
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
use Lib::Auto;
|
use Lib::Auto;
|
||||||
@@ -37,11 +41,12 @@ use API::Log qw(alog dbug);
|
|||||||
#use DB::Flatfile;
|
#use DB::Flatfile;
|
||||||
use Parser::Config;
|
use Parser::Config;
|
||||||
use Parser::Lang;
|
use Parser::Lang;
|
||||||
use Parser::IRC;
|
use Proto::IRC;
|
||||||
use Core::IRC;
|
use Core::IRC;
|
||||||
|
use Core::IRC::Users;
|
||||||
use Core::Cmd;
|
use Core::Cmd;
|
||||||
|
|
||||||
our $VERSION = 3.0.0;
|
our $VERSION = 3.000000;
|
||||||
local $PROGRAM_NAME = 'auto';
|
local $PROGRAM_NAME = 'auto';
|
||||||
|
|
||||||
# Check for build files.
|
# Check for build files.
|
||||||
@@ -94,6 +99,63 @@ API::Std::event_add('on_sigterm');
|
|||||||
API::Std::event_add('on_sigint');
|
API::Std::event_add('on_sigint');
|
||||||
API::Std::event_add('on_sighup');
|
API::Std::event_add('on_sighup');
|
||||||
|
|
||||||
|
# Get arguments.
|
||||||
|
our ($DEBUG, $NUC);
|
||||||
|
my ($opt_help, $opt_version, $USECONFIG);
|
||||||
|
GetOptions(
|
||||||
|
'nuc' => \$NUC,
|
||||||
|
'c=s' => \$USECONFIG,
|
||||||
|
'config=s' => \$USECONFIG,
|
||||||
|
'h' => \$opt_help,
|
||||||
|
'help' => \$opt_help,
|
||||||
|
'd' => \$DEBUG,
|
||||||
|
'debug' => \$DEBUG,
|
||||||
|
'v' => \$opt_version,
|
||||||
|
'version' => \$opt_version
|
||||||
|
);
|
||||||
|
|
||||||
|
# If we were passed -h, print help.
|
||||||
|
if ($opt_help) {
|
||||||
|
print <<'HELP';
|
||||||
|
|
||||||
|
Usage: $PROGRAM_NAME [options]
|
||||||
|
--help, -h Prints this help.
|
||||||
|
--version, -v Prints the version of this Auto.
|
||||||
|
--debug, -d Runs Auto in debug mode. Debug mode will print out debug
|
||||||
|
messages, including IRC raw data, to screen. This will also
|
||||||
|
stop Auto from forking into the background.
|
||||||
|
|
||||||
|
--config=FILENAME, -c Uses etc/FILENAME for the configuration file.
|
||||||
|
|
||||||
|
HELP
|
||||||
|
exit 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# If we were passed -v, print version.
|
||||||
|
if ($opt_version) {
|
||||||
|
say q{};
|
||||||
|
say NAME.' version '.VER.', subversion '.SVER.', revision '.REV.' ('.VER.q{.}.SVER.q{.}.REV.RSTAGE.').';
|
||||||
|
print <<'VERINFO';
|
||||||
|
|
||||||
|
Copyright (C) 2010-2011, Xelhua Development Group. All rights reserved.
|
||||||
|
|
||||||
|
Auto is released under the licensing terms of the New (3-Clause) BSD License,
|
||||||
|
which may be found in doc/LICENSE.
|
||||||
|
|
||||||
|
For documentation, you might refer to README, doc/*, and the Xelhua Wiki at
|
||||||
|
http://wiki.xelhua.org. Documentation for modules is stored in Man Page and
|
||||||
|
HTML form in autodoc/.
|
||||||
|
|
||||||
|
For support, visit the Xelhua Forums at http://forums.xelhua.org, or drop by
|
||||||
|
the official IRC chatroom at irc.xelhua.org #xelhua. Please report bugs and
|
||||||
|
request new features at http://rm.xelhua.org.
|
||||||
|
|
||||||
|
VERINFO
|
||||||
|
exit 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
undef $opt_help;
|
||||||
|
undef $opt_version;
|
||||||
|
|
||||||
# Print startup message.
|
# Print startup message.
|
||||||
say <<'EOF';
|
say <<'EOF';
|
||||||
@@ -108,18 +170,6 @@ say '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
|
|||||||
|
|
||||||
our ($APID, %TIMERS);
|
our ($APID, %TIMERS);
|
||||||
|
|
||||||
# Get arguments.
|
|
||||||
our $DEBUG = 0;
|
|
||||||
our $NUC = 0;
|
|
||||||
if (defined $ARGV[0]) {
|
|
||||||
foreach (@ARGV) {
|
|
||||||
given ($_) {
|
|
||||||
when ('-d') { $DEBUG = 1; }
|
|
||||||
when ('-nuc') { $NUC = 1; }
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Check for updates.
|
# Check for updates.
|
||||||
Lib::Auto::checkver();
|
Lib::Auto::checkver();
|
||||||
|
|
||||||
@@ -129,10 +179,14 @@ if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6; }
|
|||||||
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; }
|
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; }
|
||||||
|
|
||||||
# Parse configuration file.
|
# Parse configuration file.
|
||||||
say '* Parsing configuration file auto.conf...';
|
my $configfile = 'auto.conf';
|
||||||
our $CONF = Parser::Config->new('auto.conf') or err(1, 'Failed to parse configuration file!', 1);
|
if ($USECONFIG) { $configfile = $USECONFIG; }
|
||||||
|
say "* Parsing configuration file $configfile...";
|
||||||
|
our $CONF = Parser::Config->new($configfile) or err(1, 'Failed to parse configuration file!', 1);
|
||||||
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
|
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
|
||||||
say ' Success';
|
say ' Success';
|
||||||
|
undef $configfile;
|
||||||
|
undef $USECONFIG;
|
||||||
|
|
||||||
if (conf_get('die')) {
|
if (conf_get('die')) {
|
||||||
if ((conf_get('die'))[0][0] == 1) {
|
if ((conf_get('die'))[0][0] == 1) {
|
||||||
@@ -179,8 +233,9 @@ given (lc((conf_get('database:format'))[0][0])) {
|
|||||||
|
|
||||||
if (!-e "$Bin/../etc/".(conf_get('database:filename'))[0][0]) {
|
if (!-e "$Bin/../etc/".(conf_get('database:filename'))[0][0]) {
|
||||||
# Create <database:filename> if it's missing.
|
# Create <database:filename> if it's missing.
|
||||||
system "touch $Bin/../etc/".(conf_get('database:filename'))[0][0];
|
open my $dbfh, '>', "$Bin/../etc/".(conf_get('database:filename'))[0][0];
|
||||||
system "chmod a+x $Bin/../etc/".(conf_get('database:filename'))[0][0];
|
close $dbfh;
|
||||||
|
chmod 0755, "$Bin/../etc/".(conf_get('database:filename'))[0][0];
|
||||||
}
|
}
|
||||||
# Connect to database.
|
# 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);
|
$DB = DBI->connect("dbi:SQLite:dbname=$Bin/../etc/".(conf_get('database:filename'))[0][0]) or err(2, 'Failed to connect to database!', 1);
|
||||||
@@ -303,6 +358,14 @@ our $STARTTIME = time;
|
|||||||
say '* 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.';
|
alog 'Auto successfully started.';
|
||||||
|
|
||||||
|
# If we're on Windows, disable forking.
|
||||||
|
if ($OSNAME =~ /win/i) {
|
||||||
|
if (!$DEBUG) {
|
||||||
|
say '!!! Forking unavailable (OS is Microsoft Windows), continuing in debug mode.';
|
||||||
|
$DEBUG = 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
# Fork into the background if not in debug mode.
|
# Fork into the background if not in debug mode.
|
||||||
if (!$DEBUG) {
|
if (!$DEBUG) {
|
||||||
say '*** Becoming a daemon...';
|
say '*** Becoming a daemon...';
|
||||||
@@ -312,9 +375,6 @@ if (!$DEBUG) {
|
|||||||
$APID = fork;
|
$APID = fork;
|
||||||
if ($APID != 0) {
|
if ($APID != 0) {
|
||||||
alog '* Successfully forked into the background. Process ID: '.$APID;
|
alog '* Successfully forked into the background. Process ID: '.$APID;
|
||||||
if (!-e "$Bin/auto.pid") {
|
|
||||||
system "touch $Bin/auto.pid";
|
|
||||||
}
|
|
||||||
open my $FPID, '>', "$Bin/auto.pid" or exit;
|
open my $FPID, '>', "$Bin/auto.pid" or exit;
|
||||||
print {$FPID} "$APID\n" or exit;
|
print {$FPID} "$APID\n" or exit;
|
||||||
close $FPID or exit;
|
close $FPID or exit;
|
||||||
@@ -328,6 +388,12 @@ else {
|
|||||||
|
|
||||||
# Events.
|
# Events.
|
||||||
API::Std::event_add('on_preconnect');
|
API::Std::event_add('on_preconnect');
|
||||||
|
# CAP.
|
||||||
|
my %tcsvrs = conf_get('server');
|
||||||
|
foreach my $svr (keys %tcsvrs) {
|
||||||
|
$Proto::IRC::cap{$svr} = 'multi-prefix';
|
||||||
|
}
|
||||||
|
undef %tcsvrs;
|
||||||
|
|
||||||
# Load modules.
|
# Load modules.
|
||||||
if (conf_get('module')) {
|
if (conf_get('module')) {
|
||||||
@@ -346,89 +412,19 @@ my %cservers = conf_get('server');
|
|||||||
# Set the socket hash and select instance.
|
# Set the socket hash and select instance.
|
||||||
our (%SOCKET, $SELECT);
|
our (%SOCKET, $SELECT);
|
||||||
$SELECT = IO::Select->new();
|
$SELECT = IO::Select->new();
|
||||||
my $it = 0;
|
|
||||||
# Iterate through each configured server.
|
# Iterate through each configured server.
|
||||||
foreach my $cskey (keys %cservers) {
|
foreach my $cskey (keys %cservers) {
|
||||||
# Prepare socket data.
|
Lib::Auto::ircsock(\%{$cservers{$cskey}}, $cskey);
|
||||||
my %conndata = (
|
|
||||||
Proto => 'tcp',
|
|
||||||
LocalAddr => $cservers{$cskey}{'bind'}[0],
|
|
||||||
PeerAddr => $cservers{$cskey}{'host'}[0],
|
|
||||||
PeerPort => $cservers{$cskey}{'port'}[0],
|
|
||||||
Timeout => 20,
|
|
||||||
);
|
|
||||||
# Set IPv6/SSL data.
|
|
||||||
my $use6 = 0;
|
|
||||||
my $usessl = 0;
|
|
||||||
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
|
|
||||||
if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
|
|
||||||
|
|
||||||
# CertFP.
|
|
||||||
if ($usessl) {
|
|
||||||
if (defined $cservers{$cskey}{'certfp'}[0]) {
|
|
||||||
if ($cservers{$cskey}{'certfp'}[0] eq 1) {
|
|
||||||
$conndata{'SSL_use_cert'} = 1;
|
|
||||||
if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
|
|
||||||
$conndata{'SSL_cert_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
|
|
||||||
}
|
|
||||||
if (defined $cservers{$cskey}{'certfp_key'}[0]) {
|
|
||||||
$conndata{'SSL_key_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
|
|
||||||
}
|
|
||||||
if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
|
|
||||||
$conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Create the socket.
|
|
||||||
if ($use6) {
|
|
||||||
$SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
|
|
||||||
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and delete $SOCKET{$cskey} and next;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
if ($usessl) {
|
|
||||||
$SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
|
|
||||||
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and delete $SOCKET{$cskey} and next;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
|
|
||||||
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and delete $SOCKET{$cskey} and next;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Send PASS if we have one.
|
|
||||||
if (defined $cservers{$cskey}{'pass'}[0]) {
|
|
||||||
socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
|
|
||||||
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and next;
|
|
||||||
}
|
|
||||||
API::Std::event_run('on_preconnect', $cskey);
|
|
||||||
# Send NICK/USER.
|
|
||||||
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
|
|
||||||
socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
|
|
||||||
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and next;
|
|
||||||
# Add to select.
|
|
||||||
$SELECT->add($SOCKET{$cskey});
|
|
||||||
# Success!
|
|
||||||
alog '** Successfully connected to server: '.$cskey;
|
|
||||||
dbug '** Successfully connected to server: '.$cskey;
|
|
||||||
$it = 1;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Success!
|
# Success!
|
||||||
if ($it) {
|
if (keys %SOCKET) {
|
||||||
alog '** Success: Connected to server(s).';
|
alog '** Success: Connected to server(s).';
|
||||||
dbug '** Success: Connected to server(s).';
|
dbug '** Success: Connected to server(s).';
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
err(2, 'No server connections.', 1);
|
err(2, 'No IRC connections -- Exiting program.', 1);
|
||||||
}
|
}
|
||||||
undef $it;
|
|
||||||
|
|
||||||
# Create core commands.
|
# Create core commands.
|
||||||
API::Std::cmd_add('MODLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLOAD, \&Core::Cmd::cmd_modload);
|
API::Std::cmd_add('MODLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLOAD, \&Core::Cmd::cmd_modload);
|
||||||
@@ -477,6 +473,7 @@ while (1) {
|
|||||||
err(2, "Lost connection to $sockid!", 0);
|
err(2, "Lost connection to $sockid!", 0);
|
||||||
$SELECT->remove($sock);
|
$SELECT->remove($sock);
|
||||||
delete $SOCKET{$sockid};
|
delete $SOCKET{$sockid};
|
||||||
|
API::Std::event_run('on_disconnect', $sockid);
|
||||||
if (!keys %SOCKET) {
|
if (!keys %SOCKET) {
|
||||||
# No more connections, stop the program.
|
# No more connections, stop the program.
|
||||||
API::Std::event_run('on_shutdown');
|
API::Std::event_run('on_shutdown');
|
||||||
@@ -499,7 +496,7 @@ while (1) {
|
|||||||
dbug $sockid.' >> '.$line;
|
dbug $sockid.' >> '.$line;
|
||||||
|
|
||||||
# Parse data.
|
# Parse data.
|
||||||
Parser::IRC::ircparse($sockid, $line);
|
Proto::IRC::ircparse($sockid, $line);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -509,12 +506,11 @@ while (1) {
|
|||||||
###############
|
###############
|
||||||
|
|
||||||
# Send data to socket.
|
# Send data to socket.
|
||||||
sub socksnd
|
sub socksnd {
|
||||||
{
|
|
||||||
my ($svr, $data) = @_;
|
my ($svr, $data) = @_;
|
||||||
|
|
||||||
if (defined $SOCKET{$svr}) {
|
if (defined $SOCKET{$svr}) {
|
||||||
syswrite $SOCKET{$svr}, $data."\n", POSIX::BUFSIZ, 0;
|
syswrite $SOCKET{$svr}, $data."\r\n", POSIX::BUFSIZ, 0;
|
||||||
dbug "$svr << $data";
|
dbug "$svr << $data";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -547,4 +543,4 @@ sub mod_load {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+2
-2
@@ -126,7 +126,7 @@ foreach my $line (@MPBUF) {
|
|||||||
$got_end = 1;
|
$got_end = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($got_end and $line ne '__END__') {
|
if ($got_end and $line ne '__END__' and $line !~ m/^# vim:/sm) {
|
||||||
$podbuf .= $line."\n";
|
$podbuf .= $line."\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -150,4 +150,4 @@ $manifier->parse_from_file("$Bin/../autodoc/$module.pod", "$Bin/../autodoc/$modu
|
|||||||
print $RS;
|
print $RS;
|
||||||
say 'Done.';
|
say 'Done.';
|
||||||
|
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+1
-1
@@ -58,4 +58,4 @@ foreach (@violations) {
|
|||||||
}
|
}
|
||||||
say "$count violations in $ARGV[0].";
|
say "$count violations in $ARGV[0].";
|
||||||
|
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+1
-1
@@ -44,4 +44,4 @@ while ($fpr =~ s/(.*\n)//) {
|
|||||||
# Print the fingerprint.
|
# Print the fingerprint.
|
||||||
say 'Done. Fingerprint: '.$fp;
|
say 'Done. Fingerprint: '.$fp;
|
||||||
|
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -2,6 +2,59 @@ Auto IRC Bot 3.0: Change Log
|
|||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
3.0 Indev
|
3.0 Indev
|
||||||
|
===============================================================================
|
||||||
|
|
||||||
|
|
||||||
|
3.0 Alpha 7
|
||||||
|
===============================================================================
|
||||||
|
* Fixed a bug in UNO where rehashing during a game caused a crash.
|
||||||
|
* Proto::IRC::umodes renamed to Proto::IRC::botinfo{svr}{modes}.
|
||||||
|
* Fixed a bug where incoming PART's from ourselves were not parsed.
|
||||||
|
* Our usermodes are now tracked in Proto::IRC::umodes.
|
||||||
|
* Added events on_cmode and on_umode.
|
||||||
|
* Added event on_myinfo for RPL_MYINFO (numeric 004).
|
||||||
|
* Raw hooks now take hook names and support multiple hooks. This changes
|
||||||
|
rchook_add and rchook_del.
|
||||||
|
* Vim modelines must be at the bottom of files. Modules updated.
|
||||||
|
* Renamed Lib::Users to Core::IRC::Users.
|
||||||
|
* Added Lib::Users, for network-wide user tracking. This brings many new
|
||||||
|
possibilities to modules, including an account system.
|
||||||
|
* Added hook on_namesreply.
|
||||||
|
* All data related to a network is now deleted on disconnect.
|
||||||
|
* Added hook on_disconnect.
|
||||||
|
* Added various options to bin/auto, including support for multiple config
|
||||||
|
files. See bin/auto -h for details.
|
||||||
|
* Changed on_nick, on_quit, on_part, and on_kick source hashrefs to include
|
||||||
|
server, removing svr.
|
||||||
|
* Bumped minimum API version to 3.0.0a7.
|
||||||
|
* Fixed the arguments on_whoreply passes.
|
||||||
|
|
||||||
|
3.0 Alpha 6
|
||||||
|
===============================================================================
|
||||||
|
* Bug fix: Fixed an issue with SASL timeout.
|
||||||
|
* Added hook on_capack.
|
||||||
|
* CAP is now core.
|
||||||
|
* Fixed a bug with multi-prefix support.
|
||||||
|
* Added fpfmt() to API::Std.
|
||||||
|
* Auto::GR renamed to $Auto::VERGITREV.
|
||||||
|
* Bumped minimum version for API to 3.0.0a6.
|
||||||
|
* Changed on_topic args to: full source hashref, new topic array
|
||||||
|
* on_topic is now triggered for any topic change, regardless of source.
|
||||||
|
* Now parsing numeric 004.
|
||||||
|
* Added hook on_isupport.
|
||||||
|
* Added a BotStats module for returning statistics about the bot.
|
||||||
|
* Now parsing numeric 396.
|
||||||
|
* Added who() to API::IRC.
|
||||||
|
* Added hook on_whoreply.
|
||||||
|
* PRIVMSGs and NOTICEs that would cause a >512 bytes resulting message are
|
||||||
|
now divided into multiple messages.
|
||||||
|
* Renamed botnick to botinfo.
|
||||||
|
* Renamed Parser::IRC to Proto::IRC.
|
||||||
|
* Added an Eval module.
|
||||||
|
* Added an UNO module.
|
||||||
|
* Added on_part hook.
|
||||||
|
|
||||||
|
3.0 Alpha 5
|
||||||
===============================================================================
|
===============================================================================
|
||||||
* Bug fix: Fixed broken rehash.
|
* Bug fix: Fixed broken rehash.
|
||||||
* Ignore PRIVMSG's if they're from an invalid source.
|
* Ignore PRIVMSG's if they're from an invalid source.
|
||||||
|
|||||||
@@ -42,7 +42,7 @@ Legend:
|
|||||||
[!] Features
|
[!] Features
|
||||||
[X] Weather module
|
[X] Weather module
|
||||||
[!] Urban Dictionary module
|
[!] Urban Dictionary module
|
||||||
[ ] UNO module
|
[X] UNO module
|
||||||
[ ] Google Search module
|
[ ] Google Search module
|
||||||
[ ] IRC Relay module
|
[ ] IRC Relay module
|
||||||
[ ] (Google?) News module
|
[ ] (Google?) News module
|
||||||
@@ -51,7 +51,7 @@ Legend:
|
|||||||
[X] Google Calculator module
|
[X] Google Calculator module
|
||||||
[ ] YouTube Search module
|
[ ] YouTube Search module
|
||||||
[ ] Twitter module
|
[ ] Twitter module
|
||||||
[!] Advanced Topics module
|
[X] Advanced Topics module
|
||||||
[ ] Custom Triggers module
|
[ ] Custom Triggers module
|
||||||
[X] Shorten URL (bit.ly?) module
|
[X] Shorten URL (bit.ly?) module
|
||||||
[?] Bot Talk module
|
[?] Bot Talk module
|
||||||
|
|||||||
+18
@@ -0,0 +1,18 @@
|
|||||||
|
Auto IRC Bot 3.0: Microsoft Windows Notes
|
||||||
|
===============================================================================
|
||||||
|
|
||||||
|
When running Auto on Microsoft Windows, you should be aware of the following:
|
||||||
|
|
||||||
|
* Windows support has not been thoroughly tested, some scripts/features may not
|
||||||
|
function correctly.
|
||||||
|
* Forking into the background is disabled.
|
||||||
|
* Some file system operations may fail if Auto is installed to a path with
|
||||||
|
spaces. Please report these.
|
||||||
|
|
||||||
|
For the full power of Auto; run him in a UNIX environment.
|
||||||
|
|
||||||
|
Since Windows support can be considered experimental, testers are welcome and
|
||||||
|
you should report anything you find to malfunction.
|
||||||
|
|
||||||
|
At some point in the future, we hope to achieve Windows support with no core
|
||||||
|
caveats. Again, reporting issues in Auto on Windows is highly appreciated.
|
||||||
@@ -21,15 +21,15 @@ my $features = 'base ssl sqlite';
|
|||||||
if (defined $ARGV[0]) {
|
if (defined $ARGV[0]) {
|
||||||
foreach (@ARGV) {
|
foreach (@ARGV) {
|
||||||
if ($_ eq '-h' or $_ eq '--help') {
|
if ($_ eq '-h' or $_ eq '--help') {
|
||||||
println '*** ./install help ***';
|
println '*** ./install help ***';
|
||||||
println ' --enable-sasl - Enable support for SASL.';
|
println ' --enable-sasl - Enable support for SASL.';
|
||||||
println ' --enable-ipv6 - Enable support for IPv6.';
|
println ' --enable-ipv6 - Enable support for IPv6.';
|
||||||
println ' --disable-ssl - Disable support for SSL.';
|
println ' --disable-ssl - Disable support for SSL.';
|
||||||
println '*** End of Help ***';
|
println '*** End of Help ***';
|
||||||
exit 1;
|
exit 1;
|
||||||
}
|
}
|
||||||
elsif ($_ eq '--enable-sasl') {
|
elsif ($_ eq '--enable-sasl') {
|
||||||
$features .= ' sasl';
|
$features .= ' sasl';
|
||||||
}
|
}
|
||||||
elsif ($_ eq '--disable-ssl') {
|
elsif ($_ eq '--disable-ssl') {
|
||||||
$features =~ s/ ssl//g;
|
$features =~ s/ ssl//g;
|
||||||
@@ -44,7 +44,7 @@ if (defined $ARGV[0]) {
|
|||||||
$features =~ s/(sqlite|mysql)/pgsql/g;
|
$features =~ s/(sqlite|mysql)/pgsql/g;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
println "Warning: Unknown option '$_'";
|
println "Warning: Unknown option '$_'";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -59,18 +59,21 @@ eval {
|
|||||||
print "Checking operating system..... $OSNAME - ";
|
print "Checking operating system..... $OSNAME - ";
|
||||||
if ($OSNAME =~ /dos/i) {
|
if ($OSNAME =~ /dos/i) {
|
||||||
print "DOS is not supported.\r\n";
|
print "DOS is not supported.\r\n";
|
||||||
|
exit;
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "MSWin32") {
|
elsif ($OSNAME eq "MSWin32") {
|
||||||
print "Microsoft Windows is not supported. Support is planned for the future.\r\n";
|
print "OK\r\n";
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "NetWare") {
|
elsif ($OSNAME eq "NetWare") {
|
||||||
print "NetWare is not supported.\r\n";
|
print "NetWare is not supported.\r\n";
|
||||||
|
exit;
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "linux") {
|
elsif ($OSNAME eq "linux") {
|
||||||
print "OK\n";
|
print "OK\n";
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "os2") {
|
elsif ($OSNAME eq "os2") {
|
||||||
print "IBM OS/2 is not supported.\r\n";
|
print "IBM OS/2 is not supported.\r\n";
|
||||||
|
exit;
|
||||||
}
|
}
|
||||||
elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
|
elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
|
||||||
print "OK\r";
|
print "OK\r";
|
||||||
@@ -81,8 +84,12 @@ elsif ($OSNAME eq "freebsd") {
|
|||||||
elsif ($OSNAME eq "openbsd") {
|
elsif ($OSNAME eq "openbsd") {
|
||||||
print "OK\n";
|
print "OK\n";
|
||||||
}
|
}
|
||||||
|
elsif ($OSNAME eq "solaris") {
|
||||||
|
print "OK\n";
|
||||||
|
}
|
||||||
else {
|
else {
|
||||||
print "Unknown operating system. Contact support.\r\n";
|
print "Unknown operating system. Contact support.\r\n";
|
||||||
|
exit;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check for Perl core modules.
|
# Check for Perl core modules.
|
||||||
@@ -124,19 +131,7 @@ else {
|
|||||||
println "\0";
|
println "\0";
|
||||||
println "Building.....";
|
println "Building.....";
|
||||||
if (!-d "$Bin/build") {
|
if (!-d "$Bin/build") {
|
||||||
system "mkdir $Bin/build";
|
mkdir "$Bin/build";
|
||||||
}
|
|
||||||
if (!-e "$Bin/build/time") {
|
|
||||||
system "touch $Bin/build/time";
|
|
||||||
}
|
|
||||||
if (!-e "$Bin/build/os") {
|
|
||||||
system "touch $Bin/build/os";
|
|
||||||
}
|
|
||||||
if (!-e "$Bin/build/perl") {
|
|
||||||
system "touch $Bin/build/perl";
|
|
||||||
}
|
|
||||||
if (!-e "$Bin/build/ver") {
|
|
||||||
system "touch $Bin/build/ver";
|
|
||||||
}
|
}
|
||||||
|
|
||||||
build($features);
|
build($features);
|
||||||
@@ -149,4 +144,4 @@ println q{};
|
|||||||
# Success!
|
# Success!
|
||||||
println "Done. Auto successfully installed.";
|
println "Done. Auto successfully installed.";
|
||||||
|
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+39
-16
@@ -9,8 +9,10 @@ use Exporter;
|
|||||||
|
|
||||||
our @ISA = qw(Exporter);
|
our @ISA = qw(Exporter);
|
||||||
our @EXPORT_OK = qw(ban cjoin cpart cmode umode kick privmsg notice quit nick names
|
our @EXPORT_OK = qw(ban cjoin cpart cmode umode kick privmsg notice quit nick names
|
||||||
topic usrc match_mask);
|
topic who usrc match_mask);
|
||||||
|
|
||||||
|
# Create the on_disconnect event.
|
||||||
|
API::Std::event_add('on_disconnect');
|
||||||
|
|
||||||
# Set a ban, based on config bantype value.
|
# Set a ban, based on config bantype value.
|
||||||
sub ban
|
sub ban
|
||||||
@@ -67,8 +69,6 @@ sub cpart
|
|||||||
Auto::socksnd($svr, "PART $chan :Leaving");
|
Auto::socksnd($svr, "PART $chan :Leaving");
|
||||||
}
|
}
|
||||||
|
|
||||||
if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; }
|
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -87,7 +87,7 @@ sub umode
|
|||||||
{
|
{
|
||||||
my ($svr, $modes) = @_;
|
my ($svr, $modes) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
|
Auto::socksnd($svr, "MODE ".$Proto::IRC::botinfo{$svr}{nick}." $modes");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -97,7 +97,15 @@ sub privmsg
|
|||||||
{
|
{
|
||||||
my ($svr, $target, $message) = @_;
|
my ($svr, $target, $message) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "PRIVMSG $target :$message");
|
# Get maximum length.
|
||||||
|
my $maxlen = 510 - length q{:}.$Proto::IRC::botinfo{$svr}{nick}.q{!}.$Proto::IRC::botinfo{$svr}{user}.q{@}.$Proto::IRC::botinfo{$svr}{mask}." PRIVMSG $target :";
|
||||||
|
|
||||||
|
# Divide message if it surpasses the maximum length.
|
||||||
|
while (length $message >= $maxlen) {
|
||||||
|
my $submsg = substr $message, 0, $maxlen, q{};
|
||||||
|
Auto::socksnd($svr, "PRIVMSG $target :$submsg");
|
||||||
|
}
|
||||||
|
if (length $message) { Auto::socksnd($svr, "PRIVMSG $target :$message") }
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -107,7 +115,15 @@ sub notice
|
|||||||
{
|
{
|
||||||
my ($svr, $target, $message) = @_;
|
my ($svr, $target, $message) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "NOTICE $target :$message");
|
# Get maximum length.
|
||||||
|
my $maxlen = 510 - length q{:}.$Proto::IRC::botinfo{$svr}{nick}.q{!}.$Proto::IRC::botinfo{$svr}{user}.q{@}.$Proto::IRC::botinfo{$svr}{mask}." NOTICE $target :";
|
||||||
|
|
||||||
|
# Divide message if it surpasses the maximum length.
|
||||||
|
while (length $message >= $maxlen) {
|
||||||
|
my $submsg = substr $message, 0, $maxlen, q{};
|
||||||
|
Auto::socksnd($svr, "NOTICE $target :$submsg");
|
||||||
|
}
|
||||||
|
if (length $message) { Auto::socksnd($svr, "NOTICE $target :$message") }
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -129,8 +145,8 @@ sub nick
|
|||||||
|
|
||||||
Auto::socksnd($svr, "NICK $newnick");
|
Auto::socksnd($svr, "NICK $newnick");
|
||||||
|
|
||||||
$Parser::IRC::botnick{$svr}{newnick} = $newnick;
|
$Proto::IRC::botinfo{$svr}{newnick} = $newnick;
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -165,23 +181,30 @@ sub kick
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Quit IRC.
|
# Quit IRC.
|
||||||
sub quit
|
sub quit {
|
||||||
{
|
|
||||||
my ($svr, $reason) = @_;
|
my ($svr, $reason) = @_;
|
||||||
|
|
||||||
if (defined $reason) {
|
if (defined $reason) {
|
||||||
Auto::socksnd($svr, "QUIT :$reason");
|
Auto::socksnd($svr, "QUIT :$reason");
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
Auto::socksnd($svr, "QUIT :Leaving");
|
Auto::socksnd($svr, 'QUIT :Leaving');
|
||||||
}
|
}
|
||||||
|
|
||||||
delete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr});
|
# Trigger on_disconnect.
|
||||||
delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr});
|
API::Std::event_run('on_disconnect', $svr);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Send a WHO.
|
||||||
|
sub who {
|
||||||
|
my ($svr, $nick) = @_;
|
||||||
|
|
||||||
|
Auto::socksnd($svr, "WHO $nick");
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
# Get nick, ident and host from a <nick>!<ident>@<host>
|
# Get nick, ident and host from a <nick>!<ident>@<host>
|
||||||
sub usrc
|
sub usrc
|
||||||
@@ -219,4 +242,4 @@ sub match_mask
|
|||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+5
-9
@@ -10,7 +10,7 @@ use POSIX;
|
|||||||
use Time::Local;
|
use Time::Local;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
use base qw(Exporter);
|
use base qw(Exporter);
|
||||||
use API::Std qw(conf_get);
|
use API::Std qw(conf_get fpfmt);
|
||||||
|
|
||||||
our @EXPORT_OK = qw(println dbug alog slog);
|
our @EXPORT_OK = qw(println dbug alog slog);
|
||||||
|
|
||||||
@@ -59,10 +59,6 @@ sub alog
|
|||||||
if (!-d "$Auto::Bin/../var") {
|
if (!-d "$Auto::Bin/../var") {
|
||||||
mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||||
}
|
}
|
||||||
# Create var/DATE.log if it doesn't exist.
|
|
||||||
if (!-e "$Auto::Bin/../var/$date.log") {
|
|
||||||
system "touch $Auto::Bin/../var/$date.log";
|
|
||||||
}
|
|
||||||
|
|
||||||
# Open the logfile, print the log message to it and close it.
|
# Open the logfile, print the log message to it and close it.
|
||||||
open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
|
open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
|
||||||
@@ -89,7 +85,7 @@ sub expire_logs
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Iterate through each logfile.
|
# Iterate through each logfile.
|
||||||
foreach my $file (glob "$Auto::Bin/../var/*") {
|
foreach my $file (glob fpfmt("$Auto::Bin/../var/*")) {
|
||||||
my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
|
my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
|
||||||
|
|
||||||
# Convert filename to UNIX time.
|
# Convert filename to UNIX time.
|
||||||
@@ -118,7 +114,7 @@ sub slog
|
|||||||
# It is, continue.
|
# It is, continue.
|
||||||
|
|
||||||
# Split the network and channel.
|
# Split the network and channel.
|
||||||
my ($net, $chan) = split '/', (conf_get('logchan'))[0][0];
|
my ($net, $chan) = split m/[\/]/xsm, (conf_get('logchan'))[0][0];
|
||||||
$chan = lc $chan;
|
$chan = lc $chan;
|
||||||
|
|
||||||
# Check if we're connected to the network.
|
# Check if we're connected to the network.
|
||||||
@@ -129,7 +125,7 @@ sub slog
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Check if we're in the channel.
|
# Check if we're in the channel.
|
||||||
if (!defined $Parser::IRC::botchans{$net}{$chan}) {
|
if (!defined $Proto::IRC::botchans{$net}{$chan}) {
|
||||||
dbug 'WARNING: slog(): Unable to log to IRC: Not in channel.';
|
dbug 'WARNING: slog(): Unable to log to IRC: Not in channel.';
|
||||||
alog 'WARNING: slog(): Unable to log to IRC: Not in channel.';
|
alog 'WARNING: slog(): Unable to log to IRC: Not in channel.';
|
||||||
return;
|
return;
|
||||||
@@ -143,4 +139,4 @@ sub slog
|
|||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+34
-17
@@ -9,10 +9,10 @@ use Exporter;
|
|||||||
use base qw(Exporter);
|
use base qw(Exporter);
|
||||||
|
|
||||||
|
|
||||||
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
|
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS, %RAWHOOKS);
|
||||||
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add
|
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add
|
||||||
cmd_del hook_add hook_del rchook_add rchook_del match_user
|
cmd_del hook_add hook_del rchook_add rchook_del match_user
|
||||||
has_priv mod_exists ratelimit_check);
|
has_priv mod_exists ratelimit_check fpfmt);
|
||||||
|
|
||||||
|
|
||||||
# Initialize a module.
|
# Initialize a module.
|
||||||
@@ -26,7 +26,7 @@ sub mod_init
|
|||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); }
|
||||||
|
|
||||||
# Check if this module is compatible with this version of Auto.
|
# Check if this module is compatible with this version of Auto.
|
||||||
if ($autover ne '3.0.0a4' and $autover ne '3.0.0a5') {
|
if ($autover !~ m/^3\.0\.0a(7)$/xsm) {
|
||||||
API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
|
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.');
|
API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); }
|
||||||
@@ -263,12 +263,16 @@ sub timer_del
|
|||||||
# Hook onto a raw command.
|
# Hook onto a raw command.
|
||||||
sub rchook_add
|
sub rchook_add
|
||||||
{
|
{
|
||||||
my ($cmd, $sub) = @_;
|
my ($cmd, $name, $sub) = @_;
|
||||||
$cmd = uc $cmd;
|
$cmd = uc $cmd;
|
||||||
|
|
||||||
if (defined $Parser::IRC::RAWC{$cmd}) { return; }
|
# Make sure core doesn't already handle this.
|
||||||
|
if (defined $Proto::IRC::RAWC{$cmd}) { return }
|
||||||
$Parser::IRC::RAWC{$cmd} = $sub;
|
# If the hook already exists, ignore it.
|
||||||
|
if (defined $RAWHOOKS{$cmd}{$name}) { return }
|
||||||
|
|
||||||
|
# Create the hook.
|
||||||
|
$RAWHOOKS{$cmd}{$name} = $sub;
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -276,12 +280,14 @@ sub rchook_add
|
|||||||
# Delete a raw command hook.
|
# Delete a raw command hook.
|
||||||
sub rchook_del
|
sub rchook_del
|
||||||
{
|
{
|
||||||
my ($cmd) = @_;
|
my ($cmd, $name) = @_;
|
||||||
$cmd = uc $cmd;
|
$cmd = uc $cmd;
|
||||||
|
|
||||||
if (!defined $Parser::IRC::RAWC{$cmd}) { return; }
|
# Make sure the hook exists.
|
||||||
|
if (!defined $RAWHOOKS{$cmd}{$name}) { return }
|
||||||
|
|
||||||
delete $Parser::IRC::RAWC{$cmd};
|
# Delete it.
|
||||||
|
delete $RAWHOOKS{$cmd}{$name};
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -386,15 +392,15 @@ sub match_user
|
|||||||
my $svr = $ulhp{net}[0];
|
my $svr = $ulhp{net}[0];
|
||||||
if (defined $Auto::SOCKET{$svr}) {
|
if (defined $Auto::SOCKET{$svr}) {
|
||||||
if ($ccnm eq 'CURRENT' and defined $user{chan}) {
|
if ($ccnm eq 'CURRENT' and defined $user{chan}) {
|
||||||
if (defined $Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
|
if (defined $Proto::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
|
||||||
if ($Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($Proto::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
foreach my $bcj (keys %{ $Parser::IRC::botchans{$svr} }) {
|
foreach my $bcj (keys %{ $Proto::IRC::botchans{$svr} }) {
|
||||||
if (API::IRC::match_mask($bcj, $ccnm)) {
|
if (API::IRC::match_mask($bcj, $ccnm)) {
|
||||||
if (defined $Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
|
if (defined $Proto::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
|
||||||
if ($Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($Proto::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -485,7 +491,10 @@ sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
|
|||||||
}
|
}
|
||||||
|
|
||||||
# If it's a fatal error, exit the program.
|
# If it's a fatal error, exit the program.
|
||||||
if ($fatal) { exit; }
|
if ($fatal) {
|
||||||
|
API::Std::event_run('on_shutdown');
|
||||||
|
exit;
|
||||||
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -516,6 +525,14 @@ sub awarn
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Formatting a file path.
|
||||||
|
sub fpfmt {
|
||||||
|
my ($path) = @_;
|
||||||
|
|
||||||
|
if ($path =~ m/\s/xsm) { return "\"$path\""; }
|
||||||
|
else { return $path; }
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+3
-3
@@ -186,10 +186,10 @@ sub cmd_restart
|
|||||||
|
|
||||||
# Time to come back from the dead!
|
# Time to come back from the dead!
|
||||||
if ($Auto::DEBUG) {
|
if ($Auto::DEBUG) {
|
||||||
system("$Auto::Bin/auto -d -nuc");
|
exec "perl $Auto::Bin/auto -d -nuc";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
system("$Auto::Bin/auto -nuc");
|
exec "perl $Auto::Bin/auto -nuc";
|
||||||
}
|
}
|
||||||
exit;
|
exit;
|
||||||
|
|
||||||
@@ -314,4 +314,4 @@ sub cmd_help
|
|||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+108
-5
@@ -19,7 +19,7 @@ hook_add("on_uprivmsg", "ctcp_version_reply", sub {
|
|||||||
notice($src->{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 {
|
else {
|
||||||
notice($src->{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::VERGITREV ".$OSNAME."\001");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -28,12 +28,12 @@ hook_add("on_uprivmsg", "ctcp_version_reply", sub {
|
|||||||
|
|
||||||
# QUIT hook; delete user from chanusers.
|
# QUIT hook; delete user from chanusers.
|
||||||
hook_add("on_quit", "quit_update_chanusers", sub {
|
hook_add("on_quit", "quit_update_chanusers", sub {
|
||||||
my (($svr, $src, undef)) = @_;
|
my (($src, undef)) = @_;
|
||||||
my %src = %{ $src };
|
my %src = %{ $src };
|
||||||
|
|
||||||
# Delete the user from all channels.
|
# Delete the user from all channels.
|
||||||
foreach my $ccu (keys %{ $Parser::IRC::chanusers{$svr} }) {
|
foreach my $ccu (keys %{ $Proto::IRC::chanusers{$src{svr}}}) {
|
||||||
if (defined $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}) { delete $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}; }
|
if (defined $Proto::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}) { delete $Proto::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}; }
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
@@ -51,6 +51,15 @@ hook_add("on_connect", "on_connect_modes", sub {
|
|||||||
return 1;
|
return 1;
|
||||||
});
|
});
|
||||||
|
|
||||||
|
# Self-WHO on connect.
|
||||||
|
hook_add('on_connect', 'on_connect_selfwho', sub {
|
||||||
|
my ($svr) = @_;
|
||||||
|
|
||||||
|
API::IRC::who($svr, $Proto::IRC::botinfo{$svr}{nick});
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
# Plaintext auth.
|
# Plaintext auth.
|
||||||
hook_add("on_connect", "plaintext_auth", sub {
|
hook_add("on_connect", "plaintext_auth", sub {
|
||||||
my ($svr) = @_;
|
my ($svr) = @_;
|
||||||
@@ -114,6 +123,54 @@ hook_add("on_connect", "autojoin", sub {
|
|||||||
return 1;
|
return 1;
|
||||||
});
|
});
|
||||||
|
|
||||||
|
# WHO reply.
|
||||||
|
hook_add('on_whoreply', 'selfwho.getdata', sub {
|
||||||
|
my (($svr, $nick, undef, $user, $mask, undef, undef, undef, undef)) = @_;
|
||||||
|
|
||||||
|
# Check if it's for us.
|
||||||
|
if ($nick eq $Proto::IRC::botinfo{$svr}{nick}) {
|
||||||
|
# It is. Set data.
|
||||||
|
$Proto::IRC::botinfo{$svr}{user} = $user;
|
||||||
|
$Proto::IRC::botinfo{$svr}{mask} = $mask;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# ISUPPORT - Set prefixes and channel modes.
|
||||||
|
hook_add('on_isupport', 'core.prefixchanmode.getdata', sub {
|
||||||
|
my (($svr, @ex)) = @_;
|
||||||
|
|
||||||
|
# Find PREFIX and CHANMODES.
|
||||||
|
foreach my $ex (@ex) {
|
||||||
|
if ($ex =~ m/^PREFIX/xsm) {
|
||||||
|
# Found PREFIX.
|
||||||
|
my $rpx = substr($ex, 8);
|
||||||
|
my ($pm, $pp) = split('\)', $rpx);
|
||||||
|
my @apm = split(//, $pm);
|
||||||
|
my @app = split(//, $pp);
|
||||||
|
foreach my $ppm (@apm) {
|
||||||
|
# Store data.
|
||||||
|
$Proto::IRC::csprefix{$svr}{$ppm} = shift(@app);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif ($ex =~ m/^CHANMODES/xsm) {
|
||||||
|
# Found CHANMODES.
|
||||||
|
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
|
||||||
|
# List modes.
|
||||||
|
foreach (split(//, $mtl)) { $Proto::IRC::chanmodes{$svr}{$_} = 1; }
|
||||||
|
# Modes with parameter.
|
||||||
|
foreach (split(//, $mtp)) { $Proto::IRC::chanmodes{$svr}{$_} = 2; }
|
||||||
|
# Modes with parameter when +.
|
||||||
|
foreach (split(//, $mtpp)) { $Proto::IRC::chanmodes{$svr}{$_} = 3; }
|
||||||
|
# Modes without parameter.
|
||||||
|
foreach (split(//, $mts)) { $Proto::IRC::chanmodes{$svr}{$_} = 4; }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
sub clear_usercmd_timer
|
sub clear_usercmd_timer
|
||||||
{
|
{
|
||||||
# If ratelimit is set to 1 in config, add this timer.
|
# If ratelimit is set to 1 in config, add this timer.
|
||||||
@@ -131,6 +188,52 @@ sub clear_usercmd_timer
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Server data deletion on disconnect.
|
||||||
|
hook_add('on_disconnect', 'core.irc.deldata', sub {
|
||||||
|
my ($svr) = @_;
|
||||||
|
|
||||||
|
# Delete all data related to the server.
|
||||||
|
if (defined $Proto::IRC::got_001{$svr}) { delete $Proto::IRC::got_001{$svr} }
|
||||||
|
if (defined $Proto::IRC::botinfo{$svr}) { delete $Proto::IRC::botinfo{$svr} }
|
||||||
|
if (defined $Proto::IRC::botchans{$svr}) { delete $Proto::IRC::botchans{$svr} }
|
||||||
|
if (defined $Proto::IRC::chanusers{$svr}) { delete $Proto::IRC::chanusers{$svr} }
|
||||||
|
if (defined $Proto::IRC::csprefix{$svr}) { delete $Proto::IRC::csprefix{$svr} }
|
||||||
|
if (defined $Proto::IRC::chanmodes{$svr}) { delete $Proto::IRC::chanmodes{$svr} }
|
||||||
|
if (defined $Proto::IRC::cap{$svr}) { delete $Proto::IRC::cap{$svr} }
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# Track our usermodes.
|
||||||
|
hook_add('on_umode', 'core.irc.state.umode', sub {
|
||||||
|
my (($svr, $modes)) = @_;
|
||||||
|
|
||||||
|
# Remove anything after a space.
|
||||||
|
$modes =~ s/(\s.*)//xsm;
|
||||||
|
|
||||||
|
# Split the modes.
|
||||||
|
my @modes = split //, $modes;
|
||||||
|
|
||||||
|
# Set operator to 1.
|
||||||
|
my $op = 1;
|
||||||
|
# Iterate through the modes.
|
||||||
|
foreach (@modes) {
|
||||||
|
if ($_ eq '-') { $op = 0 }
|
||||||
|
elsif ($_ eq '+') { $op = 1 }
|
||||||
|
else {
|
||||||
|
# Adjust our modes.
|
||||||
|
if ($op) {
|
||||||
|
$Proto::IRC::botinfo{$svr}{modes} .= $_;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$Proto::IRC::botinfo{$svr}{modes} =~ s/($_)//xsm;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -0,0 +1,132 @@
|
|||||||
|
# lib/Core/IRC/Users.pm - IRC user tracking.
|
||||||
|
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||||
|
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||||
|
package Core::IRC::Users;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use API::Std qw(hook_add);
|
||||||
|
our %users;
|
||||||
|
|
||||||
|
# Initialize the ircusers_create and ircusers_delete events.
|
||||||
|
API::Std::event_add('ircusers_create');
|
||||||
|
API::Std::event_add('ircusers_delete');
|
||||||
|
|
||||||
|
# Create the on_rcjoin hook.
|
||||||
|
hook_add('on_rcjoin', 'ircusers.onjoin', sub {
|
||||||
|
my ($src, $chan) = @_;
|
||||||
|
|
||||||
|
# Add the user to the users hash, if not already defined.
|
||||||
|
if (!$users{$src->{svr}}{lc $src->{nick}}) {
|
||||||
|
$users{$src->{svr}}{lc $src->{nick}} = $src->{nick};
|
||||||
|
API::Std::event_run('ircusers_create', ($src->{svr}, $src->{nick}));
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# Create the on_namesreply hook.
|
||||||
|
hook_add('on_namesreply', 'ircusers.names', sub {
|
||||||
|
my ($svr, $chan, undef) = @_;
|
||||||
|
|
||||||
|
# Iterate through the users for this channel.
|
||||||
|
foreach (keys %{$Proto::IRC::chanusers{$svr}{$chan}}) {
|
||||||
|
# Check if the user already exists.
|
||||||
|
if (!$users{$svr}{$_}) {
|
||||||
|
# They do not; WHO them.
|
||||||
|
API::IRC::who($svr, $_);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# Create the on_whoreply hook.
|
||||||
|
hook_add('on_whoreply', 'ircusers.who', sub {
|
||||||
|
my ($svr, $nick, undef) = @_;
|
||||||
|
|
||||||
|
# Ensure it is not us.
|
||||||
|
if (lc $nick ne lc $Proto::IRC::botinfo{$svr}{nick}) {
|
||||||
|
# It is not. Check if they're already in the users hash.
|
||||||
|
if (!$users{$svr}{lc $nick}) {
|
||||||
|
# They are not; add them.
|
||||||
|
$users{$svr}{lc $nick} = $nick;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# Create the on_nick hook.
|
||||||
|
hook_add('on_nick', 'ircusers.onnick', sub {
|
||||||
|
my ($src, $newnick) = @_;
|
||||||
|
|
||||||
|
# Modify the user's entry in the users hash.
|
||||||
|
if ($users{$src->{svr}}{lc $src->{nick}}) {
|
||||||
|
$users{$src->{svr}}{lc $newnick} = $newnick;
|
||||||
|
delete $users{$src->{svr}}{lc $src->{nick}};
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# Create the on_kick hook.
|
||||||
|
hook_add('on_kick', 'ircusers.onkick', sub {
|
||||||
|
my ($src, $kchan, $user, undef) = @_;
|
||||||
|
|
||||||
|
# Ensure there is a users hash entry for this user.
|
||||||
|
if ($users{$src->{svr}}{lc $user}) {
|
||||||
|
# Figure out if the user is in any other channel we're in.
|
||||||
|
my $ri = 0;
|
||||||
|
foreach my $chan (keys %{$Proto::IRC::chanusers{$src->{svr}}}) {
|
||||||
|
if ($chan ne $kchan) {
|
||||||
|
if (defined $Proto::IRC::chanusers{$src->{svr}}{$chan}{lc $user}) { $ri++; last; }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!$ri) {
|
||||||
|
# They are not, delete them.
|
||||||
|
delete $users{$src->{svr}}{lc $user};
|
||||||
|
API::Std::event_run('ircusers_delete', ($src->{svr}, $user));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# Create the on_part hook.
|
||||||
|
hook_add('on_part', 'ircusers.onpart', sub {
|
||||||
|
my ($src, $pchan, undef) = @_;
|
||||||
|
|
||||||
|
# Ensure there is a users hash entry for this user.
|
||||||
|
if ($users{$src->{svr}}{lc $src->{nick}}) {
|
||||||
|
# Figure out if the user is in any other channel we're in.
|
||||||
|
my $ri = 0;
|
||||||
|
foreach my $chan (keys %{$Proto::IRC::chanusers{$src->{svr}}}) {
|
||||||
|
if ($chan ne $pchan) {
|
||||||
|
if (defined $Proto::IRC::chanusers{$src->{svr}}{$chan}{lc $src->{nick}}) { $ri++; last; }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!$ri) {
|
||||||
|
# They are not, delete them.
|
||||||
|
delete $users{$src->{svr}}{lc $src->{nick}};
|
||||||
|
API::Std::event_run('ircusers_delete', ($src->{svr}, $src->{nick}));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
# Create the on_quit hook.
|
||||||
|
hook_add('on_quit', 'ircusers.onquit', sub {
|
||||||
|
my ($src, undef) = @_;
|
||||||
|
|
||||||
|
# Delete the user's entry from the users hash.
|
||||||
|
if ($users{$src->{svr}}{lc $src->{nick}}) {
|
||||||
|
delete $users{$src->{svr}}{lc $src->{nick}};
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
|
||||||
|
1;
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+94
-69
@@ -134,83 +134,108 @@ sub rehash
|
|||||||
# Iterate through each configured server.
|
# Iterate through each configured server.
|
||||||
foreach my $cskey (keys %cservers) {
|
foreach my $cskey (keys %cservers) {
|
||||||
if (!defined $Auto::SOCKET{$cskey}) {
|
if (!defined $Auto::SOCKET{$cskey}) {
|
||||||
# Prepare socket data.
|
ircsock(\%{$cservers{$cskey}}, $cskey);
|
||||||
my %conndata = (
|
|
||||||
Proto => 'tcp',
|
|
||||||
LocalAddr => $cservers{$cskey}{'bind'}[0],
|
|
||||||
PeerAddr => $cservers{$cskey}{'host'}[0],
|
|
||||||
PeerPort => $cservers{$cskey}{'port'}[0],
|
|
||||||
Timeout => 20,
|
|
||||||
);
|
|
||||||
# Set IPv6/SSL data.
|
|
||||||
my $use6 = 0;
|
|
||||||
my $usessl = 0;
|
|
||||||
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
|
|
||||||
if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
|
|
||||||
|
|
||||||
# CertFP.
|
|
||||||
if ($usessl) {
|
|
||||||
if (defined $cservers{$cskey}{'certfp'}[0]) {
|
|
||||||
if ($cservers{$cskey}{'certfp'}[0] eq 1) {
|
|
||||||
$conndata{'SSL_use_cert'} = 1;
|
|
||||||
if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
|
|
||||||
$conndata{'SSL_cert_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
|
|
||||||
}
|
|
||||||
if (defined $cservers{$cskey}{'certfp_key'}[0]) {
|
|
||||||
$conndata{'SSL_key_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
|
|
||||||
}
|
|
||||||
if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
|
|
||||||
$conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Create the socket.
|
|
||||||
if ($use6) {
|
|
||||||
$Auto::SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
|
|
||||||
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and delete $Auto::SOCKET{$cskey} and next;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
if ($usessl) {
|
|
||||||
$Auto::SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
|
|
||||||
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and delete $Auto::SOCKET{$cskey} and next;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$Auto::SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
|
|
||||||
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and delete $Auto::SOCKET{$cskey} and next;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Send PASS if we have one.
|
|
||||||
if (defined $cservers{$cskey}{'pass'}[0]) {
|
|
||||||
Auto::socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
|
|
||||||
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and next;
|
|
||||||
}
|
|
||||||
API::Std::event_run('on_preconnect', $cskey);
|
|
||||||
# Send NICK/USER.
|
|
||||||
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
|
|
||||||
Auto::socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
|
|
||||||
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
|
||||||
and next;
|
|
||||||
# Add to select.
|
|
||||||
$Auto::SELECT->add($Auto::SOCKET{$cskey});
|
|
||||||
# Success!
|
|
||||||
alog '** Successfully connected to server: '.$cskey;
|
|
||||||
dbug '** Successfully connected to server: '.$cskey;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Check for server connections.
|
||||||
|
if (!keys %Auto::SOCKET) {
|
||||||
|
err(2, 'No IRC connections -- Exiting program.', 0);
|
||||||
|
API::Std::event_run('on_shutdown');
|
||||||
|
exit 1;
|
||||||
|
}
|
||||||
|
|
||||||
# Now trigger on_rehash.
|
# Now trigger on_rehash.
|
||||||
API::Std::event_run('on_rehash');
|
API::Std::event_run('on_rehash');
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Socket creation.
|
||||||
|
sub ircsock {
|
||||||
|
my ($cdata, $svrname) = @_;
|
||||||
|
|
||||||
|
# Prepare socket data.
|
||||||
|
my %conndata = (
|
||||||
|
Proto => 'tcp',
|
||||||
|
LocalAddr => $cdata->{'bind'}[0],
|
||||||
|
PeerAddr => $cdata->{'host'}[0],
|
||||||
|
PeerPort => $cdata->{'port'}[0],
|
||||||
|
Timeout => 20,
|
||||||
|
);
|
||||||
|
# Set IPv6/SSL data.
|
||||||
|
my $use6 = 0;
|
||||||
|
my $usessl = 0;
|
||||||
|
if (defined $cdata->{'ipv6'}[0]) { $use6 = $cdata->{'ipv6'}[0]; }
|
||||||
|
if (defined $cdata->{'ssl'}[0]) { $usessl = $cdata->{'ssl'}[0]; }
|
||||||
|
|
||||||
|
# Check for appropriate build data.
|
||||||
|
if ($usessl) {
|
||||||
|
if ($Auto::ENFEAT !~ m/ssl/ixsm) { err(2, '** Auto not built with SSL support: Aborting connection to '.$svrname, 0); return; }
|
||||||
|
}
|
||||||
|
if ($use6) {
|
||||||
|
if ($Auto::ENFEAT !~ m/ipv6/ixsm) { err(2, '** Auto not built with IPv6 support: Aborting connection to '.$svrname, 0); return; }
|
||||||
|
}
|
||||||
|
|
||||||
|
# CertFP.
|
||||||
|
if ($usessl) {
|
||||||
|
if (defined $cdata->{'certfp'}[0]) {
|
||||||
|
if ($cdata->{'certfp'}[0] eq 1) {
|
||||||
|
$conndata{'SSL_use_cert'} = 1;
|
||||||
|
if (defined $cdata->{'certfp_cert'}[0]) {
|
||||||
|
$conndata{'SSL_cert_file'} = "$Auto::Bin/../etc/certs/".$cdata->{'certfp_cert'}[0];
|
||||||
|
}
|
||||||
|
if (defined $cdata->{'certfp_key'}[0]) {
|
||||||
|
$conndata{'SSL_key_file'} = "$Auto::Bin/../etc/certs/".$cdata->{'certfp_key'}[0];
|
||||||
|
}
|
||||||
|
if (defined $cdata->{'certfp_pass'}[0]) {
|
||||||
|
$conndata{'SSL_passwd_cb'} = sub { return $cdata->{'certfp_pass'}[0]; };
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Create the socket.
|
||||||
|
if ($use6) {
|
||||||
|
$Auto::SOCKET{$svrname} = IO::Socket::INET6->new(%conndata) or # Or error.
|
||||||
|
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
|
||||||
|
and delete $Auto::SOCKET{$svrname} and return;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if ($usessl) {
|
||||||
|
$Auto::SOCKET{$svrname} = IO::Socket::SSL->new(%conndata) or # Or error.
|
||||||
|
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
|
||||||
|
and delete $Auto::SOCKET{$svrname} and next;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$Auto::SOCKET{$svrname} = IO::Socket::INET->new(%conndata) or # Or error.
|
||||||
|
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
|
||||||
|
and delete $Auto::SOCKET{$svrname} and next;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Create a CAP entry if it doesn't already exist.
|
||||||
|
if (!$Proto::IRC::cap{$svrname}) { $Proto::IRC::cap{$svrname} = 'multi-prefix' }
|
||||||
|
# Send PASS if we have one.
|
||||||
|
if (defined $cdata->{'pass'}[0]) {
|
||||||
|
Auto::socksnd($svrname, 'PASS :'.$cdata->{'pass'}[0]) or return;
|
||||||
|
}
|
||||||
|
# Send CAP LS.
|
||||||
|
Auto::socksnd($svrname, 'CAP LS');
|
||||||
|
# Trigger on_preconnect.
|
||||||
|
API::Std::event_run('on_preconnect', $svrname);
|
||||||
|
# Send NICK/USER.
|
||||||
|
API::IRC::nick($svrname, $cdata->{'nick'}[0]);
|
||||||
|
Auto::socksnd($svrname, 'USER '.$cdata->{'ident'}[0].q{ }.hostname.q{ }.$cdata->{'host'}[0].' :'.$cdata->{'realname'}[0]) or return;
|
||||||
|
# Add to select.
|
||||||
|
$Auto::SELECT->add($Auto::SOCKET{$svrname});
|
||||||
|
# Success!
|
||||||
|
alog '** Successfully connected to server: '.$svrname;
|
||||||
|
dbug '** Successfully connected to server: '.$svrname;
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
# Shutdown.
|
# Shutdown.
|
||||||
hook_add('on_shutdown', 'shutdown.core_cleanup', sub {
|
hook_add('on_shutdown', 'shutdown.core_cleanup', sub {
|
||||||
if (defined $Auto::DB) { $Auto::DB->disconnect; }
|
if (defined $Auto::DB) { $Auto::DB->disconnect; }
|
||||||
@@ -283,4 +308,4 @@ sub signal_perldie
|
|||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+3
-3
@@ -119,16 +119,16 @@ sub installmods
|
|||||||
chomp $response;
|
chomp $response;
|
||||||
if (lc $response eq 'y') {
|
if (lc $response eq 'y') {
|
||||||
println 'What modules would you like to install? (separate by commas)';
|
println 'What modules would you like to install? (separate by commas)';
|
||||||
println 'Available modules: Badwords, Bitly, Calc, EightBall, FML, Greet, HelloChan, IsItUp, QDB, SASLAuth, Weather';
|
println 'Available modules: Badwords, Bitly, BotStats, Calc, ChanTopics, Dictionary, EightBall, Eval, FML, Greet, HelloChan, IsItUp, LinkTitle, QDB, SASLAuth, UNO, Weather';
|
||||||
print '> ';
|
print '> ';
|
||||||
my $modules = <STDIN>; chomp $modules;
|
my $modules = <STDIN>; chomp $modules;
|
||||||
$modules =~ s/ //g;
|
$modules =~ s/ //g;
|
||||||
my @modst = split ',', $modules;
|
my @modst = split ',', $modules;
|
||||||
foreach (@modst) {
|
foreach (@modst) {
|
||||||
system "$Bin/bin/buildmod $_";
|
system "perl \"$Bin/bin/buildmod\" $_";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -177,4 +177,4 @@ sub parse
|
|||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+1
-1
@@ -64,4 +64,4 @@ sub parse
|
|||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -1,17 +1,21 @@
|
|||||||
# lib/Parser/IRC.pm - Subroutines for parsing incoming data from IRC.
|
# lib/Proto/IRC.pm - Subroutines for parsing incoming data from IRC.
|
||||||
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
||||||
# This program is free software; rights to this code are stated in doc/LICENSE.
|
# This program is free software; rights to this code are stated in doc/LICENSE.
|
||||||
package Parser::IRC;
|
package Proto::IRC;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use feature qw(switch);
|
||||||
use API::Std qw(conf_get err awarn trans);
|
use API::Std qw(conf_get err awarn trans);
|
||||||
use API::IRC;
|
use API::IRC;
|
||||||
|
|
||||||
# Raw parsing hash.
|
# Raw parsing hash.
|
||||||
our %RAWC = (
|
our %RAWC = (
|
||||||
'001' => \&num001,
|
'001' => \&num001,
|
||||||
|
'004' => \&num004,
|
||||||
'005' => \&num005,
|
'005' => \&num005,
|
||||||
|
'352' => \&num352,
|
||||||
'353' => \&num353,
|
'353' => \&num353,
|
||||||
|
'396' => \&num396,
|
||||||
'432' => \&num432,
|
'432' => \&num432,
|
||||||
'433' => \&num433,
|
'433' => \&num433,
|
||||||
'438' => \&num438,
|
'438' => \&num438,
|
||||||
@@ -21,6 +25,7 @@ our %RAWC = (
|
|||||||
'474' => \&num474,
|
'474' => \&num474,
|
||||||
'475' => \&num475,
|
'475' => \&num475,
|
||||||
'477' => \&num477,
|
'477' => \&num477,
|
||||||
|
'CAP' => \&cap,
|
||||||
'JOIN' => \&cjoin,
|
'JOIN' => \&cjoin,
|
||||||
'KICK' => \&kick,
|
'KICK' => \&kick,
|
||||||
'MODE' => \&mode,
|
'MODE' => \&mode,
|
||||||
@@ -33,25 +38,34 @@ our %RAWC = (
|
|||||||
);
|
);
|
||||||
|
|
||||||
# Variables for various functions.
|
# Variables for various functions.
|
||||||
our (%got_001, %botnick, %botchans, %csprefix, %chanusers, %chanmodes);
|
our (%got_001, %botinfo, %botchans, %csprefix, %chanusers, %chanmodes, %cap);
|
||||||
|
|
||||||
# Events.
|
# Events.
|
||||||
API::Std::event_add("on_connect");
|
API::Std::event_add('on_capack');
|
||||||
API::Std::event_add("on_rcjoin");
|
API::Std::event_add('on_cmode');
|
||||||
API::Std::event_add("on_ucjoin");
|
API::Std::event_add('on_umode');
|
||||||
API::Std::event_add("on_kick");
|
API::Std::event_add('on_connect');
|
||||||
API::Std::event_add("on_nick");
|
API::Std::event_add('on_rcjoin');
|
||||||
API::Std::event_add("on_notice");
|
API::Std::event_add('on_ucjoin');
|
||||||
API::Std::event_add("on_cprivmsg");
|
API::Std::event_add('on_isupport');
|
||||||
API::Std::event_add("on_uprivmsg");
|
API::Std::event_add('on_kick');
|
||||||
API::Std::event_add("on_quit");
|
API::Std::event_add('on_myinfo');
|
||||||
API::Std::event_add("on_topic");
|
API::Std::event_add('on_namesreply');
|
||||||
|
API::Std::event_add('on_nick');
|
||||||
|
API::Std::event_add('on_notice');
|
||||||
|
API::Std::event_add('on_part');
|
||||||
|
API::Std::event_add('on_upart');
|
||||||
|
API::Std::event_add('on_cprivmsg');
|
||||||
|
API::Std::event_add('on_uprivmsg');
|
||||||
|
API::Std::event_add('on_quit');
|
||||||
|
API::Std::event_add('on_topic');
|
||||||
|
API::Std::event_add('on_whoreply');
|
||||||
|
|
||||||
# Parse raw data.
|
# Parse raw data.
|
||||||
sub ircparse
|
sub ircparse
|
||||||
{
|
{
|
||||||
my ($svr, $data) = @_;
|
my ($svr, $data) = @_;
|
||||||
|
|
||||||
# Split spaces into @ex.
|
# Split spaces into @ex.
|
||||||
my @ex = split /\s+/, $data;
|
my @ex = split /\s+/, $data;
|
||||||
|
|
||||||
@@ -60,22 +74,28 @@ sub ircparse
|
|||||||
# If it's a ping...
|
# If it's a ping...
|
||||||
if ($ex[0] eq 'PING') {
|
if ($ex[0] eq 'PING') {
|
||||||
# send a PONG.
|
# send a PONG.
|
||||||
Auto::socksnd($svr, "PONG ".$ex[1]);
|
Auto::socksnd($svr, "PONG $ex[1]");
|
||||||
}
|
}
|
||||||
# If it's AUTHENTICATE
|
# If it's AUTHENTICATE
|
||||||
elsif ($ex[0] eq 'AUTHENTICATE') {
|
elsif ($ex[0] eq 'AUTHENTICATE') {
|
||||||
if (API::Std::mod_exists("SASLAuth")) {
|
if (API::Std::mod_exists('SASLAuth')) {
|
||||||
M::SASLAuth::handle_authenticate($svr, @ex);
|
M::SASLAuth::handle_authenticate($svr, @ex);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
# Check if it's handled by core.
|
||||||
|
elsif (defined $RAWC{$ex[1]}) {
|
||||||
|
&{ $RAWC{$ex[1]} }($svr, @ex);
|
||||||
|
}
|
||||||
else {
|
else {
|
||||||
# otherwise, check %RAWC for ex[1].
|
# otherwise, check for a raw hook.
|
||||||
if (defined $RAWC{$ex[1]}) {
|
if (defined $API::Std::RAWHOOKS{$ex[1]}) {
|
||||||
&{ $RAWC{$ex[1]} }($svr, @ex);
|
foreach (keys %{$API::Std::RAWHOOKS{$ex[1]}}) {
|
||||||
|
&{ $API::Std::RAWHOOKS{$ex[1]}{$_} }($svr, @ex);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -85,224 +105,288 @@ sub ircparse
|
|||||||
|
|
||||||
# Parse: Numeric:001
|
# Parse: Numeric:001
|
||||||
# Successful connection.
|
# Successful connection.
|
||||||
sub num001
|
sub num001 {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
$got_001{$svr} = 1;
|
$got_001{$svr} = 1;
|
||||||
|
|
||||||
# In case we don't get NICK from the server.
|
# In case we don't get NICK from the server.
|
||||||
if (defined $botnick{$svr}{newnick}) {
|
if (!defined $botinfo{$svr}{nick}) {
|
||||||
$botnick{$svr}{nick} = $botnick{$svr}{newnick};
|
$botinfo{$svr}{nick} = $botinfo{$svr}{newnick};
|
||||||
delete $botnick{$svr}{newnick};
|
delete $botinfo{$svr}{newnick};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Log.
|
||||||
|
API::Log::alog "! Successfully connected to $svr as $botinfo{$svr}{nick}";
|
||||||
|
API::Log::dbug "! Successfully connected to $svr as $botinfo{$svr}{nick}";
|
||||||
|
|
||||||
# Trigger on_connect.
|
# Trigger on_connect.
|
||||||
API::Std::event_run("on_connect", $svr);
|
API::Std::event_run('on_connect', $svr);
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse: Numeric:004
|
||||||
|
# Server information.
|
||||||
|
sub num004 {
|
||||||
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
|
# Log server name and version.
|
||||||
|
API::Log::alog "! $svr: $ex[3] running version $ex[4]";
|
||||||
|
API::Log::dbug "! $svr: $ex[3] running version $ex[4]";
|
||||||
|
|
||||||
|
# Trigger on_myinfo.
|
||||||
|
API::Std::event_run('on_myinfo', ($svr, @ex[3..$#ex]));
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:005
|
# Parse: Numeric:005
|
||||||
# Prefixes and channel modes.
|
# Server ISUPPORT.
|
||||||
sub num005
|
sub num005 {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
# Find PREFIX and CHANMODES.
|
# Trigger on_isupport.
|
||||||
foreach my $ex (@ex) {
|
API::Std::event_run('on_isupport', ($svr, @ex[3..$#ex]));
|
||||||
if ($ex =~ m/^PREFIX/xsm) {
|
|
||||||
# Found PREFIX.
|
return 1;
|
||||||
my $rpx = substr($ex, 8);
|
}
|
||||||
my ($pm, $pp) = split('\)', $rpx);
|
|
||||||
my @apm = split(//, $pm);
|
# Parse: Numeric:352
|
||||||
my @app = split(//, $pp);
|
# WHO reply.
|
||||||
foreach my $ppm (@apm) {
|
sub num352 {
|
||||||
# Store data.
|
my ($svr, @ex) = @_;
|
||||||
$csprefix{$svr}{$ppm} = shift(@app);
|
|
||||||
}
|
# Trigger on_whoreply.
|
||||||
}
|
$ex[9] =~ s/^://xsm;
|
||||||
elsif ($ex =~ m/^CHANMODES/xsm) {
|
API::Std::event_run('on_whoreply', ($svr, $ex[7], $ex[3], $ex[4], $ex[5], $ex[6], $ex[8], $ex[9], @ex[10..$#ex]));
|
||||||
# Found CHANMODES.
|
|
||||||
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
|
|
||||||
# List modes.
|
|
||||||
foreach (split(//, $mtl)) { $chanmodes{$svr}{$_} = 1; }
|
|
||||||
# Modes with parameter.
|
|
||||||
foreach (split(//, $mtp)) { $chanmodes{$svr}{$_} = 2; }
|
|
||||||
# Modes with parameter when +.
|
|
||||||
foreach (split(//, $mtpp)) { $chanmodes{$svr}{$_} = 3; }
|
|
||||||
# Modes without parameter.
|
|
||||||
foreach (split(//, $mts)) { $chanmodes{$svr}{$_} = 4; }
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:353
|
# Parse: Numeric:353
|
||||||
# NAMES reply.
|
# NAMES reply.
|
||||||
sub num353
|
sub num353 {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
# Get rid of the colon.
|
# Get rid of the colon.
|
||||||
$ex[5] = substr($ex[5], 1);
|
$ex[5] =~ s/^://xsm;
|
||||||
# Delete the old chanusers hash if it exists.
|
# Delete the old chanusers hash if it exists.
|
||||||
delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
|
if (defined $chanusers{$svr}{$ex[4]}) { delete $chanusers{$svr}{$ex[4]} }
|
||||||
# Iterate through each user.
|
# Iterate through each user.
|
||||||
for (my $i = 5; $i < scalar(@ex); $i++) {
|
for (5..$#ex) {
|
||||||
my $fi = 0;
|
my $fi = 0;
|
||||||
foreach (keys %{ $csprefix{$svr} }) {
|
PFITER: foreach my $spfx (keys %{ $csprefix{$svr} }) {
|
||||||
# Check if the user has status in the channel.
|
# Check if the user has status in the channel.
|
||||||
if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) {
|
if (substr($ex[$_], 0, 1) eq $csprefix{$svr}{$spfx}) {
|
||||||
# He/she does. Lets set that.
|
# He/she does. Lets set that.
|
||||||
if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) {
|
if (defined $chanusers{$svr}{$ex[4]}{lc $ex[$_]}) {
|
||||||
# If the user has multiple statuses.
|
# If the user has multiple statuses.
|
||||||
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_;
|
$chanusers{$svr}{$ex[4]}{lc substr $ex[$_], 1} = $chanusers{$svr}{$ex[4]}{lc $ex[$_]}.$spfx;
|
||||||
|
delete $chanusers{$svr}{$ex[4]}{lc $ex[$_]};
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Or not.
|
# Or not.
|
||||||
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
|
$chanusers{$svr}{$ex[4]}{lc substr $ex[$_], 1} = $spfx;
|
||||||
}
|
}
|
||||||
$fi = 1;
|
$fi = 1;
|
||||||
|
$ex[$_] = substr $ex[$_], 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
# Check if there's still a prefix.
|
||||||
|
foreach my $spfx (keys %{$csprefix{$svr}}) {
|
||||||
|
if (substr($ex[$_], 0, 1) eq $csprefix{$svr}{$spfx}) { goto 'PFITER' }
|
||||||
|
}
|
||||||
# They had status, so go to the next user.
|
# They had status, so go to the next user.
|
||||||
next if $fi;
|
next if $fi;
|
||||||
# They didn't, set them as a normal user.
|
# They didn't, set them as a normal user.
|
||||||
if (!defined $chanusers{$svr}{$ex[4]}{lc($ex[$i])}) {
|
if (!defined $chanusers{$svr}{$ex[4]}{lc $ex[$_]}) {
|
||||||
$chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1;
|
$chanusers{$svr}{$ex[4]}{lc $ex[$_]} = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Trigger on_namesreply.
|
||||||
|
API::Std::event_run('on_namesreply', ($svr, $ex[4], @ex[5..$#ex]));
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse: Numeric:396
|
||||||
|
# Hidden host changed.
|
||||||
|
sub num396 {
|
||||||
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
|
# Update our mask.
|
||||||
|
$botinfo{$svr}{mask} = $ex[3];
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:432
|
# Parse: Numeric:432
|
||||||
# Erroneous nickname.
|
# Erroneous nickname.
|
||||||
sub num432
|
sub num432 {
|
||||||
{
|
|
||||||
my ($svr, undef) = @_;
|
my ($svr, undef) = @_;
|
||||||
|
|
||||||
if ($got_001{$svr}) {
|
if ($got_001{$svr}) {
|
||||||
err(3, "Got error from server[".$svr."]: Erroneous nickname.", 0);
|
err(3, "Got error from server[$svr]: Erroneous nickname.", 0);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
err(2, "Got error from server[".$svr."] before 001: Erroneous nickname. Closing connection.", 0);
|
err(2, "Got error from server[$svr] before connection complete: Erroneous nickname. Closing connection.", 0);
|
||||||
API::IRC::quit($svr, "An error occurred.");
|
API::IRC::quit($svr, 'An error occurred.');
|
||||||
}
|
}
|
||||||
|
|
||||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
if (defined $botinfo{$svr}{newnick}) { delete $botinfo{$svr}{newnick} }
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:433
|
# Parse: Numeric:433
|
||||||
# Nickname is already in use.
|
# Nickname is already in use.
|
||||||
sub num433
|
sub num433 {
|
||||||
{
|
|
||||||
my ($svr, undef) = @_;
|
my ($svr, undef) = @_;
|
||||||
|
|
||||||
if (defined $botnick{$svr}{newnick}) {
|
if (defined $botinfo{$svr}{newnick}) {
|
||||||
API::IRC::nick($svr, $botnick{$svr}{newnick}."_");
|
API::IRC::nick($svr, $botinfo{$svr}{newnick}.'_');
|
||||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:438
|
# Parse: Numeric:438
|
||||||
# Nick change too fast.
|
# Nick change too fast.
|
||||||
sub num438
|
sub num438 {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
if (defined $botnick{$svr}{newnick}) {
|
if (defined $botinfo{$svr}{newnick}) {
|
||||||
API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub {
|
API::Std::timer_add('num438_'.$botinfo{$svr}{newnick}, 1, $ex[11], sub {
|
||||||
API::IRC::nick($Parser::IRC::botnick{$svr}{newnick});
|
API::IRC::nick($Proto::IRC::botinfo{$svr}{newnick});
|
||||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
if (defined $botinfo{$svr}{newnick}) { delete $botinfo{$svr}{newnick} }
|
||||||
});
|
});
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:465
|
# Parse: Numeric:465
|
||||||
# You're banned creep!
|
# You're banned creep!
|
||||||
sub num465
|
sub num465 {
|
||||||
{
|
|
||||||
my ($svr, undef) = @_;
|
my ($svr, undef) = @_;
|
||||||
|
|
||||||
err(3, "Banned from ".$svr."! Closing link...", 0);
|
err(3, "Banned from $svr.! Closing link...", 0);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:471
|
# Parse: Numeric:471
|
||||||
# Cannot join channel: Channel is full.
|
# Cannot join channel: Channel is full.
|
||||||
sub num471
|
sub num471 {
|
||||||
{
|
|
||||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||||
|
|
||||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is full.", 0);
|
err(3, "Cannot join channel $chan on $svr: Channel is full.", 0);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:473
|
# Parse: Numeric:473
|
||||||
# Cannot join channel: Channel is invite-only.
|
# Cannot join channel: Channel is invite-only.
|
||||||
sub num473
|
sub num473 {
|
||||||
{
|
|
||||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||||
|
|
||||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is invite-only.", 0);
|
err(3, "Cannot join channel $chan on $svr: Channel is invite-only.", 0);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:474
|
# Parse: Numeric:474
|
||||||
# Cannot join channel: Banned from channel.
|
# Cannot join channel: Banned from channel.
|
||||||
sub num474
|
sub num474 {
|
||||||
{
|
|
||||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||||
|
|
||||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0);
|
err(3, "Cannot join channel $chan on $svr: Banned from channel.", 0);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:475
|
# Parse: Numeric:475
|
||||||
# Cannot join channel: Bad key.
|
# Cannot join channel: Bad key.
|
||||||
sub num475
|
sub num475 {
|
||||||
{
|
|
||||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||||
|
|
||||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0);
|
err(3, "Cannot join channel $chan on $svr: Bad key.", 0);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:477
|
# Parse: Numeric:477
|
||||||
# Cannot join channel: Need registered nickname.
|
# Cannot join channel: Need registered nickname.
|
||||||
sub num477
|
sub num477 {
|
||||||
{
|
|
||||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||||
|
|
||||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0);
|
err(3, "Cannot join channel $chan on $svr: Need registered nickname.", 0);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Parse: CAP
|
||||||
|
sub cap {
|
||||||
|
my ($svr, @ex) = @_;
|
||||||
|
my $capout;
|
||||||
|
|
||||||
|
# Iterate ex[3].
|
||||||
|
given ($ex[3]) {
|
||||||
|
when ('LS') {
|
||||||
|
# Get our CAP REQ list.
|
||||||
|
my @capreq = ();
|
||||||
|
if ($cap{$svr} =~ m/\s/xsm) { @capreq = split ' ', $cap{$svr} }
|
||||||
|
else { push @capreq, $cap{$svr} }
|
||||||
|
|
||||||
|
# Iterate through what we received from the server.
|
||||||
|
$ex[4] =~ s/^://xsm;
|
||||||
|
foreach my $scap (@ex[4..$#ex]) {
|
||||||
|
# Check if we support this.
|
||||||
|
foreach my $icap (@capreq) {
|
||||||
|
if ($icap eq $scap) {
|
||||||
|
$capout .= " $scap";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Send CAP REQ/CAP END based on what both we and the server support.
|
||||||
|
if (!$capout) { Auto::socksnd($svr, 'CAP END'); }
|
||||||
|
else {
|
||||||
|
$capout = substr $capout, 1;
|
||||||
|
Auto::socksnd($svr, "CAP REQ :$capout");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
when ('ACK') {
|
||||||
|
# Iterate through the ACK arguments.
|
||||||
|
$ex[4] =~ s/^://xsm;
|
||||||
|
my $sasl = 0;
|
||||||
|
foreach (@ex[4..$#ex]) {
|
||||||
|
if ($_ eq 'sasl') { $sasl++ }
|
||||||
|
API::Std::event_run('on_capack', ($svr, $_));
|
||||||
|
}
|
||||||
|
Auto::socksnd($svr, 'CAP END') unless $sasl;
|
||||||
|
}
|
||||||
|
when ('NAK') {
|
||||||
|
# This should never happen, but just in case...
|
||||||
|
API::Log::awarn(2, "$svr: CAP failed: Server refused '$capout'");
|
||||||
|
Auto::socksnd($svr, 'CAP END');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
# Parse: JOIN
|
# Parse: JOIN
|
||||||
sub cjoin
|
sub cjoin {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||||
my $chan = $ex[2];
|
my $chan = $ex[2];
|
||||||
$chan =~ s/^://gxsm;
|
$chan =~ s/^://gxsm;
|
||||||
|
|
||||||
# Check if this is coming from ourselves.
|
# Check if this is coming from ourselves.
|
||||||
if ($src{nick} eq $botnick{$svr}{nick}) {
|
if ($src{nick} eq $botinfo{$svr}{nick}) {
|
||||||
$botchans{$svr}{lc $chan} = 1;
|
$botchans{$svr}{lc $chan} = 1;
|
||||||
API::Std::event_run("on_ucjoin", ($svr, $chan));
|
API::Std::event_run("on_ucjoin", ($svr, $chan));
|
||||||
}
|
}
|
||||||
@@ -317,10 +401,11 @@ sub cjoin
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Parse: KICK
|
# Parse: KICK
|
||||||
sub kick
|
sub kick {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||||
|
$src{svr} = $svr;
|
||||||
|
|
||||||
# Update chanusers.
|
# Update chanusers.
|
||||||
delete $chanusers{$svr}{$ex[2]}{$ex[3]} if defined $chanusers{$svr}{$ex[2]}{$ex[3]};
|
delete $chanusers{$svr}{$ex[2]}{$ex[3]} if defined $chanusers{$svr}{$ex[2]}{$ex[3]};
|
||||||
@@ -337,7 +422,7 @@ sub kick
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Check if we were the ones kicked.
|
# Check if we were the ones kicked.
|
||||||
if (lc($ex[3]) eq lc($botnick{$svr}{nick})) {
|
if (lc($ex[3]) eq lc($botinfo{$svr}{nick})) {
|
||||||
# We were kicked!
|
# We were kicked!
|
||||||
|
|
||||||
# Delete channel from botchans.
|
# Delete channel from botchans.
|
||||||
@@ -356,21 +441,23 @@ sub kick
|
|||||||
else {
|
else {
|
||||||
# We weren't. Update chanusers and trigger on_kick.
|
# We weren't. Update chanusers and trigger on_kick.
|
||||||
if (defined $chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $chanusers{$svr}{$ex[2]}{$ex[3]}; }
|
if (defined $chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $chanusers{$svr}{$ex[2]}{$ex[3]}; }
|
||||||
API::Std::event_run("on_kick", ($svr, \%src, $ex[2], $ex[3], $msg));
|
API::Std::event_run("on_kick", (\%src, $ex[2], $ex[3], $msg));
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: MODE
|
# Parse: MODE
|
||||||
sub mode
|
sub mode {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
if ($ex[2] ne $botnick{$svr}{nick}) {
|
if ($ex[2] ne $botinfo{$svr}{nick}) {
|
||||||
# Set data we'll need later.
|
# Set data we'll need later.
|
||||||
my $chan = $ex[2];
|
my $chan = $ex[2];
|
||||||
|
$ex[3] =~ s/^://xsm;
|
||||||
my $modes = $ex[3];
|
my $modes = $ex[3];
|
||||||
|
my $fmodes = join ' ', @ex[3..$#ex];
|
||||||
|
$modes =~ s/^://xsm;
|
||||||
# Get rid of the useless data, so the mode parser will work smoothly.
|
# Get rid of the useless data, so the mode parser will work smoothly.
|
||||||
shift @ex; shift @ex; shift @ex; shift @ex;
|
shift @ex; shift @ex; shift @ex; shift @ex;
|
||||||
|
|
||||||
@@ -446,24 +533,30 @@ sub mode
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
# Trigger on_cmode.
|
||||||
|
API::Std::event_run('on_cmode', ($svr, $chan, $fmodes));
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
# User mode change; trigger on_umode.
|
||||||
|
$ex[3] =~ s/^://xsm;
|
||||||
|
API::Std::event_run('on_umode', ($svr, @ex[3..$#ex]));
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: NICK
|
# Parse: NICK
|
||||||
sub nick
|
sub nick {
|
||||||
{
|
|
||||||
my ($svr, ($uex, undef, $nex)) = @_;
|
my ($svr, ($uex, undef, $nex)) = @_;
|
||||||
$nex = substr($nex, 1);
|
$nex =~ s/^://gxsm;
|
||||||
|
|
||||||
my %src = API::IRC::usrc(substr($uex, 1));
|
my %src = API::IRC::usrc(substr($uex, 1));
|
||||||
|
$src{svr} = $svr;
|
||||||
|
|
||||||
# Check if this is coming from ourselves.
|
# Check if this is coming from ourselves.
|
||||||
if ($src{nick} eq $botnick{$svr}{nick}) {
|
if ($src{nick} eq $botinfo{$svr}{nick}) {
|
||||||
# It is. Update bot nick hash.
|
# It is. Update bot nick hash.
|
||||||
$botnick{$svr}{nick} = $nex;
|
$botinfo{$svr}{nick} = $nex;
|
||||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
delete $botinfo{$svr}{newnick} if (defined $botinfo{$svr}{newnick});
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# It isn't. Update chanusers and trigger on_nick.
|
# It isn't. Update chanusers and trigger on_nick.
|
||||||
@@ -473,15 +566,14 @@ sub nick
|
|||||||
delete $chanusers{$svr}{$chk}{$src{nick}};
|
delete $chanusers{$svr}{$chk}{$src{nick}};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
API::Std::event_run("on_nick", ($svr, \%src, $nex));
|
API::Std::event_run("on_nick", (\%src, $nex));
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: NOTICE
|
# Parse: NOTICE
|
||||||
sub notice
|
sub notice {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
# Ensure this is coming from a user rather than a server.
|
# Ensure this is coming from a user rather than a server.
|
||||||
@@ -501,34 +593,43 @@ sub notice
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Parse: PART
|
# Parse: PART
|
||||||
sub part
|
sub part {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
|
||||||
|
|
||||||
# Delete them from chanusers.
|
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||||
delete $chanusers{$svr}{$ex[2]}{$src{nick}} if defined $chanusers{$svr}{$ex[2]}{$src{nick}};
|
$src{svr} = $svr;
|
||||||
|
|
||||||
# Set $msg to the part message.
|
# Check if it's from us or someone else.
|
||||||
my $msg = 0;
|
if ($src{nick} eq $botinfo{$svr}{nick}) {
|
||||||
if (defined $ex[3]) {
|
# Delete this channel from botchans.
|
||||||
$msg = substr($ex[3], 1);
|
if ($botchans{$svr}{$ex[2]}) { delete $botchans{$svr}{$ex[2]}; }
|
||||||
if (defined $ex[4]) {
|
# Trigger on_upart.
|
||||||
for (my $i = 4; $i < scalar(@ex); $i++) {
|
API::Std::event_run('on_upart', ($svr, $ex[2]));
|
||||||
$msg .= " ".$ex[$i];
|
}
|
||||||
|
else {
|
||||||
|
# Delete them from chanusers.
|
||||||
|
delete $chanusers{$svr}{$ex[2]}{$src{nick}} if defined $chanusers{$svr}{$ex[2]}{$src{nick}};
|
||||||
|
|
||||||
|
# Set $msg to the part message.
|
||||||
|
my $msg = 0;
|
||||||
|
if (defined $ex[3]) {
|
||||||
|
$msg = substr($ex[3], 1);
|
||||||
|
if (defined $ex[4]) {
|
||||||
|
for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||||
|
$msg .= " ".$ex[$i];
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
# Trigger on_part.
|
# Trigger on_part.
|
||||||
API::Std::event_run("on_part", ($svr, \%src, $ex[2], $msg));
|
API::Std::event_run("on_part", (\%src, $ex[2], $msg));
|
||||||
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: PRIVMSG
|
# Parse: PRIVMSG
|
||||||
sub privmsg
|
sub privmsg {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
my %data = API::IRC::usrc(substr($ex[0], 1));
|
my %data = API::IRC::usrc(substr($ex[0], 1));
|
||||||
|
|
||||||
@@ -543,7 +644,7 @@ sub privmsg
|
|||||||
|
|
||||||
my ($cmd, $cprefix, $rprefix);
|
my ($cmd, $cprefix, $rprefix);
|
||||||
# Check if it's to a channel or to us.
|
# Check if it's to a channel or to us.
|
||||||
if (lc($ex[2]) eq lc($botnick{$svr}{nick})) {
|
if (lc($ex[2]) eq lc($botinfo{$svr}{nick})) {
|
||||||
# It is coming to us in a private message.
|
# It is coming to us in a private message.
|
||||||
|
|
||||||
# Ensure it's a valid length.
|
# Ensure it's a valid length.
|
||||||
@@ -655,10 +756,11 @@ sub privmsg
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Parse: QUIT
|
# Parse: QUIT
|
||||||
sub quit
|
sub quit {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||||
|
$src{svr} = $svr;
|
||||||
|
|
||||||
# Set $msg to the quit message.
|
# Set $msg to the quit message.
|
||||||
my $msg = 0;
|
my $msg = 0;
|
||||||
@@ -672,33 +774,25 @@ sub quit
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Trigger on_quit.
|
# Trigger on_quit.
|
||||||
API::Std::event_run("on_quit", ($svr, \%src, $msg));
|
API::Std::event_run("on_quit", (\%src, $msg));
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: TOPIC
|
# Parse: TOPIC
|
||||||
sub topic
|
sub topic {
|
||||||
{
|
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||||
|
$src{svr} = $svr;
|
||||||
|
$src{chan} = $ex[2];
|
||||||
|
$ex[3] = substr $ex[3], 1;
|
||||||
|
|
||||||
# Ignore it if it's coming from us.
|
# Trigger on_topic.
|
||||||
if (lc($src{nick}) ne lc($botnick{$svr}{nick})) {
|
API::Std::event_run('on_topic', (\%src, @ex[3..$#ex]));
|
||||||
$src{chan} = $ex[2];
|
|
||||||
my (@argv);
|
|
||||||
$argv[0] = substr($ex[3], 1);
|
|
||||||
if (defined $ex[4]) {
|
|
||||||
for (my $i = 4; $i < scalar(@ex); $i++) {
|
|
||||||
push(@argv, $ex[$i]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
API::Std::event_run("on_topic", ($svr, \%src, @argv));
|
|
||||||
}
|
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
# vim: set ai sw=4 ts=4:
|
# vim: set ai et sw=4 ts=4:
|
||||||
+4
-3
@@ -70,8 +70,7 @@ sub actonbadword
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: perl=5.010000
|
# build: perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -122,6 +121,8 @@ Changing the obvious to your wish.
|
|||||||
|
|
||||||
=over
|
=over
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
This module is compatible with Auto version 3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+4
-3
@@ -118,8 +118,7 @@ sub reverse
|
|||||||
|
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: cpan=LWP::UserAgent,URI::Escape perl=5.010000
|
# build: cpan=LWP::UserAgent,URI::Escape perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -179,6 +178,8 @@ Add Bitly to module auto-load and the following to your configuration file:
|
|||||||
This module adds extra dependencies: LWP::UserAgent and URI::Escape. You can
|
This module adds extra dependencies: LWP::UserAgent and URI::Escape. You can
|
||||||
get it from the CPAN <http://www.cpan.org>.
|
get it from the CPAN <http://www.cpan.org>.
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
This module is compatible with Auto version 3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -0,0 +1,116 @@
|
|||||||
|
# Module: BotStats. 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::BotStats;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use English qw(-no_match_vars);
|
||||||
|
use API::Std qw(cmd_add cmd_del);
|
||||||
|
use API::IRC qw(privmsg);
|
||||||
|
|
||||||
|
# Initialization subroutine.
|
||||||
|
sub _init {
|
||||||
|
# Create the STATS command.
|
||||||
|
cmd_add('STATS', 2, 0, \%M::BotStats::HELP_STATS, \&M::BotStats::stats) or return;
|
||||||
|
|
||||||
|
# Success.
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Void subroutine.
|
||||||
|
sub _void {
|
||||||
|
# Delete the STATS command.
|
||||||
|
cmd_del('STATS') or return;
|
||||||
|
|
||||||
|
# Success.
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Help hash for STATS. Spanish, German and French translations needed.
|
||||||
|
our %HELP_STATS = (
|
||||||
|
'en' => "This command will return information about the bot (uptime, version, etc.). \2Syntax:\2 STATS",
|
||||||
|
);
|
||||||
|
|
||||||
|
# Callback for STATS command.
|
||||||
|
sub stats {
|
||||||
|
my ($src, undef) = @_;
|
||||||
|
|
||||||
|
# Check if this was private or public.
|
||||||
|
my $target;
|
||||||
|
if ($src->{chan}) {
|
||||||
|
$target = $src->{chan};
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$target = $src->{nick};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Get uptime data.
|
||||||
|
my $uptime = time - $Auto::STARTTIME;
|
||||||
|
my $days = my $hours = my $mins = my $secs = 0;
|
||||||
|
while ($uptime >= 86_400) { $days++; $uptime -= 86_400; }
|
||||||
|
while ($uptime >= 3_600) { $hours++; $uptime -= 3_600; }
|
||||||
|
while ($uptime >= 60) { $mins++; $uptime -= 60; }
|
||||||
|
while ($uptime >= 1) { $secs++; $uptime--; }
|
||||||
|
|
||||||
|
# Return it.
|
||||||
|
privmsg($src->{svr}, $target, "I have been running for \2$days\2 days, \2$hours\2 hours, \2$mins\2 minutes, and \2$secs\2 seconds.");
|
||||||
|
|
||||||
|
# Return version data.
|
||||||
|
privmsg($src->{svr}, $target, 'I am running '.Auto::NAME.' (version '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.") for Perl $PERL_VERSION on $OSNAME.");
|
||||||
|
|
||||||
|
# Get network and channel data.
|
||||||
|
my $nets = keys %Auto::SOCKET;
|
||||||
|
my $chans;
|
||||||
|
foreach my $net (keys %Auto::SOCKET) {
|
||||||
|
foreach (keys %{$Proto::IRC::botchans{$net}}) { $chans++; }
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return network/channel data.
|
||||||
|
privmsg($src->{svr}, $target, "I am on \2$chans\2 channels across \2$nets\2 networks.");
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
API::Std::mod_init('BotStats', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
|
# build: perl=5.010000
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
BotStats - General information about the bot
|
||||||
|
|
||||||
|
=head1 VERSION
|
||||||
|
|
||||||
|
1.00
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
<starcoder> !stats
|
||||||
|
<blue> I have been running for 0 days, 0 hours, 1 minutes, and 5 seconds.
|
||||||
|
<blue> I am running Auto IRC Bot (version 3.0.0a7) for Perl v5.12.3 on linux.
|
||||||
|
<blue> I am on 2 channels, across 1 networks.
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This module creates the STATS command, for returning general information about
|
||||||
|
the bot such as uptime, version, etc.
|
||||||
|
|
||||||
|
This module is compatible with Auto v3.0.0a7+.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
This module was written by Elijah Perrault.
|
||||||
|
|
||||||
|
This module is maintained by Xelhua Development Group.
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
This module is Copyright 2010-2011 Xelhua Development Group.
|
||||||
|
|
||||||
|
This module is released under the same licensing terms as Auto itself.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+4
-3
@@ -78,8 +78,7 @@ sub calc
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000
|
# build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -119,6 +118,8 @@ Google Calculator.
|
|||||||
This module requires LWP::UserAgent, URI::Escape and JSON/JSON::PP.
|
This module requires LWP::UserAgent, URI::Escape and JSON/JSON::PP.
|
||||||
All are obtainable from the CPAN <http://www.cpan.org>.
|
All are obtainable from the CPAN <http://www.cpan.org>.
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
This module is compatible with Auto version 3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -282,8 +282,7 @@ sub _getdata
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: perl=5.010000
|
# build: perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -338,8 +337,10 @@ This module adds no extra dependencies.
|
|||||||
|
|
||||||
This module is not compatible with PostgreSQL, yet.
|
This module is not compatible with PostgreSQL, yet.
|
||||||
|
|
||||||
This module is compatible with Auto v3.0.0a4+.
|
This module is compatible with Auto v3.0.0a7+.
|
||||||
|
|
||||||
Ported from v1.0.
|
Ported from v1.0.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -75,8 +75,7 @@ sub cmd_dict
|
|||||||
|
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: cpan=Net::Dict perl=5.010000
|
# build: cpan=Net::Dict perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -99,6 +98,8 @@ DICT command.
|
|||||||
This module adds an extra dependency: Net::Dict. You can get it from the CPAN
|
This module adds an extra dependency: Net::Dict. You can get it from the CPAN
|
||||||
<http://www.cpan.org>.
|
<http://www.cpan.org>.
|
||||||
|
|
||||||
This module is compatible with Auto v3.0.0a4+.
|
This module is compatible with Auto v3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+28
-29
@@ -99,52 +99,51 @@ sub rigball
|
|||||||
|
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('EightBall', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('EightBall', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: perl=5.010000
|
# build: perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
=head1 EightBall
|
=head1 NAME
|
||||||
|
|
||||||
=head2 Description
|
Eightball - A magic eightball module.
|
||||||
|
|
||||||
=over
|
=head1 VERSION
|
||||||
|
|
||||||
|
1.00
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
<JohnSmith> !8ball Will I be rich?
|
||||||
|
<Auto> Question: Will I be rich?
|
||||||
|
<Auto> Answer: Heck no!
|
||||||
|
>Auto< rigball Of course!
|
||||||
|
<JohnSmith> !8ball Will I be famous?
|
||||||
|
<Auto> Question: Will I be famous?
|
||||||
|
<Auto> Answer: Of course!
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
This module adds the 8BALL and RIGBALL commands, 8BALL is a channel
|
This module adds the 8BALL and RIGBALL commands, 8BALL is a channel
|
||||||
command for asking the magic 8-Ball a question, RIGBALL is a private
|
command for asking the magic 8-Ball a question, RIGBALL is a private
|
||||||
command for setting ("rigging") the 8-Ball's next answer.
|
command for setting ("rigging") the 8-Ball's next answer.
|
||||||
|
|
||||||
=back
|
=head1 INSTALL
|
||||||
|
|
||||||
=head2 Examples
|
No additonal steps need to be taking to use this module.
|
||||||
|
|
||||||
=over
|
=head1 AUTHOR
|
||||||
|
|
||||||
<JohnSmith> !8ball Will I be rich?
|
This module was written by Elijah Perrault.
|
||||||
<Auto> Question: Will I be rich?
|
|
||||||
<Auto> Answer: Heck no!
|
|
||||||
>Auto< rigball Of course!
|
|
||||||
<JohnSmith> !8ball Will I be famous?
|
|
||||||
<Auto> Question: Will I be famous?
|
|
||||||
<Auto> Answer: Of course!
|
|
||||||
|
|
||||||
=back
|
This module is maintained by Xelhua Development Group.
|
||||||
|
|
||||||
=head2 To Do
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
=over
|
This module is Copyright 2010-2011 Xelhua Development Group.
|
||||||
|
|
||||||
* Add Spanish, French and German translations for the help hashes.
|
Released under the same licensing terms as Auto itself.
|
||||||
|
|
||||||
=back
|
=cut
|
||||||
|
|
||||||
=head2 Technical
|
# vim: set ai et sw=4 ts=4:
|
||||||
|
|
||||||
=over
|
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
|
||||||
|
|
||||||
Ported from Auto 1.0.
|
|
||||||
|
|
||||||
=back
|
|
||||||
+107
@@ -0,0 +1,107 @@
|
|||||||
|
# Module: Eval. 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::Eval;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use English qw(-no_match_vars);
|
||||||
|
use API::Std qw(cmd_add cmd_del trans);
|
||||||
|
use API::IRC qw(privmsg notice);
|
||||||
|
|
||||||
|
# Initialization subroutine.
|
||||||
|
sub _init {
|
||||||
|
# Create the EVAL command.
|
||||||
|
cmd_add('EVAL', 2, 'cmd.eval', \%M::Eval::HELP_EVAL, \&M::Eval::cmd_eval) or return;
|
||||||
|
|
||||||
|
# Success.
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Void subroutine.
|
||||||
|
sub _void {
|
||||||
|
# Delete the EVAL command.
|
||||||
|
cmd_del('EVAL') or return;
|
||||||
|
|
||||||
|
# Success.
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Help hash for EVAL command. Spanish, German and French translations are needed.
|
||||||
|
our %HELP_EVAL = (
|
||||||
|
'en' => "This command allows you to eval Perl code. USE WITH CAUTION. \2Syntax:\2 EVAL <expression>",
|
||||||
|
);
|
||||||
|
|
||||||
|
# Callback for EVAL command.
|
||||||
|
sub cmd_eval {
|
||||||
|
my ($src, @argv) = @_;
|
||||||
|
|
||||||
|
# Check for needed parameter.
|
||||||
|
if (!defined $argv[0]) {
|
||||||
|
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Evaluate the expression and return the result.
|
||||||
|
my $expr = join ' ', @argv;
|
||||||
|
my $result = eval($expr);
|
||||||
|
if (!defined $result) { $result = 'None'; }
|
||||||
|
if ($EVAL_ERROR) {
|
||||||
|
$result = $EVAL_ERROR;
|
||||||
|
$result =~ s/(\r|\n)//gxsm;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return the result.
|
||||||
|
if (!defined $src->{chan}) {
|
||||||
|
notice($src->{svr}, $src->{nick}, "Output: $result");
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
privmsg($src->{svr}, $src->{chan}, "$src->{nick}: $result");
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# Start initialization.
|
||||||
|
API::Std::mod_init('Eval', 'Xelhua', '1.01', '3.0.0a7', __PACKAGE__);
|
||||||
|
# build: perl=5.010000
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Eval - Allows you to evaluate Perl code from IRC
|
||||||
|
|
||||||
|
=head1 VERSION
|
||||||
|
|
||||||
|
1.01
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
>blue< eval 1;
|
||||||
|
-blue- Output: 1
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This module adds the EVAL command which allows you to evaluate Perl code from
|
||||||
|
IRC, returning the output via notice.
|
||||||
|
|
||||||
|
This command requires the cmd.eval privilege.
|
||||||
|
|
||||||
|
This module is compatible with Auto v3.0.0a7+.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
This module was written by Elijah Perrault.
|
||||||
|
|
||||||
|
This module is maintained by Xelhua Development Group.
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
This module is Copyright 2010-2011 Xelhua Development Group.
|
||||||
|
|
||||||
|
This module is released under the same licensing terms as Auto itself.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+4
-3
@@ -67,8 +67,7 @@ sub fml
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: cpan=LWP::UserAgent perl=5.010000
|
# build: cpan=LWP::UserAgent perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -110,8 +109,10 @@ have my hand back?" FML
|
|||||||
This module adds an extra dependency: LWP::UserAgent. You can get it from
|
This module adds an extra dependency: LWP::UserAgent. You can get it from
|
||||||
the CPAN <http://www.cpan.org>.
|
the CPAN <http://www.cpan.org>.
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
This module is compatible with Auto version 3.0.0a7+.
|
||||||
|
|
||||||
Ported from Auto 2.0.
|
Ported from Auto 2.0.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+4
-3
@@ -125,8 +125,7 @@ sub hook_rcjoin
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: perl=5.010000
|
# build: perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -154,6 +153,8 @@ user that has a greet in the database joins a channel the bot is in.
|
|||||||
|
|
||||||
=over
|
=over
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
This module is compatible with Auto version 3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+35
-6
@@ -36,16 +36,45 @@ sub hello
|
|||||||
|
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: perl=5.010000
|
# build: perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
||||||
=head1 HelloChan
|
=head1 NAME
|
||||||
|
|
||||||
=over
|
HelloChan - An example module. Also, cows go moo.
|
||||||
|
|
||||||
This is an example module. Also, cows go moo.
|
=head1 VERSION
|
||||||
|
|
||||||
=back
|
1.00
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
* Auto has joined #moocows
|
||||||
|
<Auto> Hello channel! I am a bot!
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This module sends "Hello channel! I am a bot!" whenever it
|
||||||
|
joins a channel.
|
||||||
|
|
||||||
|
=head1 INSTALL
|
||||||
|
|
||||||
|
No additonal steps need to be taking to use this module.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
This module was written by Elijah Perrault.
|
||||||
|
|
||||||
|
This module is maintained by Xelhua Development Group.
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
This module is Copyright 2010-2011 Xelhua Development Group.
|
||||||
|
|
||||||
|
Released under the same licensing terms as Auto itself.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+4
-3
@@ -69,8 +69,7 @@ sub check
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: cpan=LWP::UserAgent perl=5.010000
|
# build: cpan=LWP::UserAgent perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -110,6 +109,8 @@ appears up or down to Auto.
|
|||||||
This module requires LWP::UserAgent. You can get it from
|
This module requires LWP::UserAgent. You can get it from
|
||||||
the CPAN <http://www.cpan.org>.
|
the CPAN <http://www.cpan.org>.
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
This module is compatible with Auto version 3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -66,8 +66,7 @@ sub gettitle
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('LinkTitle', 'Xelhua', '1.00', '3.0.0a5', __PACKAGE__);
|
API::Std::mod_init('LinkTitle', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: cpan=LWP::UserAgent,HTML::Entities perl=5.010000
|
# build: cpan=LWP::UserAgent,HTML::Entities perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -120,3 +119,7 @@ This module is Copyright 2010-2011 Xelhua Development Group. All rights
|
|||||||
reserved.
|
reserved.
|
||||||
|
|
||||||
This module is released under the same licensing terms as Auto itself.
|
This module is released under the same licensing terms as Auto itself.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+119
@@ -0,0 +1,119 @@
|
|||||||
|
# Module: Oper.
|
||||||
|
# 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::Oper;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use API::Std qw(hook_add hook_del rchook_add rchook_del conf_get);
|
||||||
|
use API::Log qw(alog);
|
||||||
|
|
||||||
|
# Initialization subroutine.
|
||||||
|
sub _init
|
||||||
|
{
|
||||||
|
# Add a hook for when we join a channel.
|
||||||
|
hook_add("on_connect", "Oper.onconnect", \&M::Oper::on_connect) or return 0;
|
||||||
|
# Add a hook for when we get numeric 491 (ERR_NOOPERHOST)
|
||||||
|
rchook_add("491", "Oper.on381", \&M::Oper::on_num491) or return 0;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Void subroutine.
|
||||||
|
sub _void
|
||||||
|
{
|
||||||
|
# Delete the hooks.
|
||||||
|
hook_del("on_connect", "Oper.onconnect") or return 0;
|
||||||
|
rchook_del("381", "Oper.on381") or return 0;
|
||||||
|
rchook_del("313", "Oper.on313") or return 0;
|
||||||
|
rchook_del("491", "Oper.on491") or return 0;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# On connect subroutine.
|
||||||
|
sub on_connect
|
||||||
|
{
|
||||||
|
my ($svr) = @_;
|
||||||
|
# Get the configuration values.
|
||||||
|
my $u = (conf_get("server:$svr:oper_username"))[0][0] if conf_get("server:$svr:oper_username");
|
||||||
|
my $p = (conf_get("server:$svr:oper_password"))[0][0] if conf_get("server:$svr:oper_password");
|
||||||
|
# They don't exist - don't continue.
|
||||||
|
return if !$u or !$p;
|
||||||
|
# Send the OPER command.
|
||||||
|
oper($svr, $u, $p);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# On 491 subroutine
|
||||||
|
sub on_num491 {
|
||||||
|
my ($svr, @ex) = @_;
|
||||||
|
my $reason = join ' ', @ex[3 .. $#ex];
|
||||||
|
$reason =~ s/://xsm;
|
||||||
|
alog("FAILED OPER on ".$svr.": ".$reason);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# A subroutine to check if we are opered on a server
|
||||||
|
sub is_opered {
|
||||||
|
my ($svr) = @_;
|
||||||
|
# Auto is not opered.
|
||||||
|
return 0 if $Proto::IRC::botinfo{$svr}{modes} !~ m/o/xsm;
|
||||||
|
# Auto is opered.
|
||||||
|
return 1 if $Proto::IRC::botinfo{$svr}{modes} =~ m/o/xsm;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Start of the API
|
||||||
|
|
||||||
|
# Sends the OPER command to the specified server.
|
||||||
|
sub oper {
|
||||||
|
my ($svr, $user, $pass) = @_;
|
||||||
|
Auto::socksnd($svr, "OPER $user $pass");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Start initialization.
|
||||||
|
API::Std::mod_init('Oper', 'Xelhua', '1.01', '3.0.0a7', __PACKAGE__);
|
||||||
|
# build: perl=5.010000
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Oper - Auto oper-on-connect module.
|
||||||
|
|
||||||
|
=head1 VERSION
|
||||||
|
|
||||||
|
1.01
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
No commands are currently associated with Oper.
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This module adds the ability for Auto to oper on networks he is
|
||||||
|
configured to do so on.
|
||||||
|
|
||||||
|
=head1 INSTALL
|
||||||
|
|
||||||
|
Before using Oper, add the following to the server block in your
|
||||||
|
configuration file, only for servers you wish for Auto to oper on
|
||||||
|
though:
|
||||||
|
|
||||||
|
oper_username <username>;
|
||||||
|
oper_password <password>;
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
This module was written by Matthew Barksdale.
|
||||||
|
|
||||||
|
This module is maintained by Xelhua Development Group.
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
This module is Copyright 2010-2011 Xelhua Development Group.
|
||||||
|
|
||||||
|
Released under the same licensing terms as Auto itself.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+3
-2
@@ -211,8 +211,7 @@ sub cmd_qdb
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
API::Std::mod_init('QDB', 'Xelhua', '1.02', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('QDB', 'Xelhua', '1.02', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: perl=5.010000
|
# build: perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -260,3 +259,5 @@ This module is Copyright 2010-2011 Xelhua Development Group.
|
|||||||
Released under the same licensing terms as Auto itself.
|
Released under the same licensing terms as Auto itself.
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+32
-50
@@ -14,18 +14,20 @@ use API::IRC qw(privmsg);
|
|||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Check if this Auto was built with SASL support.
|
# Check if this Auto was built with SASL support.
|
||||||
err(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/;
|
if ($Auto::ENFEAT !~ m/sasl/xsm) { err(2, 'Auto was not built with SASL support. Aborting SASLAuth.', 0) and return; }
|
||||||
# Add a hook for before we connect.
|
# Add sasl to supported CAP for servers configured with SASL.
|
||||||
hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); }
|
my %servers = conf_get('server');
|
||||||
) or return 0;
|
foreach my $svr (keys %servers) {
|
||||||
# Hook for parsing CAP.
|
if (conf_get("server:$svr:sasl_username") and conf_get("server:$svr:sasl_password") and conf_get("server:$svr:sasl_timeout")) { $Proto::IRC::cap{$svr} .= ' sasl'; }
|
||||||
rchook_add('CAP', \&M::SASLAuth::handle_cap) or return 0;
|
}
|
||||||
|
# Hook for when CAP ACK sasl is received.
|
||||||
|
hook_add('on_capack', 'sasl.cap', \&M::SASLAuth::handle_capack) or return;
|
||||||
# Hook for parsing 903.
|
# Hook for parsing 903.
|
||||||
rchook_add('903', \&M::SASLAuth::handle_903) or return 0;
|
rchook_add('903', 'sasl.903', \&M::SASLAuth::handle_903) or return;
|
||||||
# Hook for parsing 904.
|
# Hook for parsing 904.
|
||||||
rchook_add('904', \&M::SASLAuth::handle_904) or return 0;
|
rchook_add('904', 'sasl.904', \&M::SASLAuth::handle_904) or return;
|
||||||
# Hook for parsing 906.
|
# Hook for parsing 906.
|
||||||
rchook_add('906', \&M::SASLAuth::handle_906) or return 0;
|
rchook_add('906', 'sasl.906', \&M::SASLAuth::handle_906) or return;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -33,42 +35,21 @@ sub _init
|
|||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the hooks.
|
# Delete the hooks.
|
||||||
hook_del("on_preconnect", "CAP") or return 0;
|
hook_del('on_capack') or return;
|
||||||
rchook_del('CAP');
|
rchook_del('903', 'sasl.903') or return;
|
||||||
rchook_del('903');
|
rchook_del('904', 'sasl.904') or return;
|
||||||
rchook_del('904');
|
rchook_del('906', 'sasl.906') or return;
|
||||||
rchook_del('906');
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub handle_cap {
|
sub handle_capack {
|
||||||
my ($srv, @parv) = @_;
|
my (($svr, $sacap)) = @_;
|
||||||
my $line = join(' ',@parv);
|
|
||||||
my ($tosend);
|
if ($sacap eq 'sasl') {
|
||||||
|
Auto::socksnd($svr, 'AUTHENTICATE PLAIN');
|
||||||
given ($line) {
|
timer_add('auth_timeout_'.$svr, 1, (conf_get("server:$svr:sasl_timeout"))[0][0], sub { Auto::socksnd($svr, 'CAP END'); });
|
||||||
when (/ LS /) {
|
|
||||||
$tosend .= 'multi-prefix ' if $line =~ /multi-prefix/i;
|
|
||||||
$tosend .= 'sasl ' if $line =~ /sasl/ and conf_get("server:$srv:sasl_username");
|
|
||||||
awarn(2, "SASL is unavailable on this server.") if $tosend !~ /sasl/;
|
|
||||||
if ($tosend eq '') { Auto::socksnd($srv, 'CAP END') }
|
|
||||||
else { Auto::socksnd($srv, "CAP REQ :$tosend"); }
|
|
||||||
}
|
|
||||||
when (/ ACK /) {
|
|
||||||
if ( $line =~ /sasl/) {
|
|
||||||
Auto::socksnd($srv, 'AUTHENTICATE PLAIN');
|
|
||||||
timer_add('auth_timeout', 1, (conf_get("server:$srv:sasl_timeout"))[0][0], sub { Auto::socksnd($srv, 'CAP END'); });
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
Auto::socksnd($srv, 'CAP END');
|
|
||||||
awarn(2, "SASL authentication failed at ACK");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
when (/ NAK /) {
|
|
||||||
Auto::socksnd($srv, 'CAP END');
|
|
||||||
awarn(2, "SASL authentication failed. Server refused ".$tosend);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -105,8 +86,8 @@ sub handle_authenticate
|
|||||||
sub handle_903
|
sub handle_903
|
||||||
{
|
{
|
||||||
my ($srv, undef) = @_;
|
my ($srv, undef) = @_;
|
||||||
Auto::socksnd($srv, 'CAP END');
|
timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
|
||||||
timer_del('auth_timeout');
|
timer_del('auth_timeout_'.$srv);
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:904
|
# Parse: Numeric:904
|
||||||
@@ -114,8 +95,8 @@ sub handle_903
|
|||||||
sub handle_904
|
sub handle_904
|
||||||
{
|
{
|
||||||
my ($srv, undef) = @_;
|
my ($srv, undef) = @_;
|
||||||
Auto::socksnd($srv, 'CAP END');
|
timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
|
||||||
timer_del('auth_timeout');
|
timer_del('auth_timeout_'.$srv);
|
||||||
awarn(2, "SASL authentication failed!");
|
awarn(2, "SASL authentication failed!");
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -124,14 +105,13 @@ sub handle_904
|
|||||||
sub handle_906
|
sub handle_906
|
||||||
{
|
{
|
||||||
my ($svr, undef) = @_;
|
my ($svr, undef) = @_;
|
||||||
Auto::socksnd($svr, 'CAP END');
|
timer_add('cap_end_'.$svr, 1, 2, sub { Auto::socksnd($svr, 'CAP END') });
|
||||||
timer_del('auth_timeout');
|
timer_del('auth_timeout_'.$svr);
|
||||||
awarn(2, "SASL authentication aborted!");
|
awarn(2, "SASL authentication aborted!");
|
||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: perl=5.010000
|
# build: perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -188,6 +168,8 @@ block(s) you wish to use SASL with:
|
|||||||
This adds an extra dependency: You must build Auto with the
|
This adds an extra dependency: You must build Auto with the
|
||||||
--enable-sasl option.
|
--enable-sasl option.
|
||||||
|
|
||||||
This module is compatible with Auto v3.0.0a4+.
|
This module is compatible with Auto v3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
+1457
File diff suppressed because it is too large.
Load diff
+4
-3
@@ -78,8 +78,7 @@ sub weather
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
|
||||||
# vim: set ai sw=4 ts=4:
|
|
||||||
# build: cpan=LWP::UserAgent,XML::Simple perl=5.010000
|
# build: cpan=LWP::UserAgent,XML::Simple perl=5.010000
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
@@ -121,6 +120,8 @@ From the NE at 9 MPH Gusting to 22 MPH Conditions: Overcast
|
|||||||
This module requires LWP::UserAgent and XML::Simple. Both are
|
This module requires LWP::UserAgent and XML::Simple. Both are
|
||||||
obtainable from CPAN <http://www.cpan.org>.
|
obtainable from CPAN <http://www.cpan.org>.
|
||||||
|
|
||||||
This module is compatible with Auto version 3.0.0a4+.
|
This module is compatible with Auto version 3.0.0a7+.
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
# vim: set ai et sw=4 ts=4:
|
||||||
@@ -0,0 +1,70 @@
|
|||||||
|
# OSI-approved software licenses as of February 26, 2011.
|
||||||
|
my %licenses = (
|
||||||
|
auto => 'Same license as Auto itself',
|
||||||
|
afl => 'Academic Free License',
|
||||||
|
agpl => 'Affero GNU Public License',
|
||||||
|
apl => 'Adaptive Public License',
|
||||||
|
apache => 'Apache License',
|
||||||
|
apsl => 'Apple Public Source License',
|
||||||
|
art => 'Artistic License',
|
||||||
|
aal => 'Attribution Assurance License',
|
||||||
|
nbsd => 'New BSD License',
|
||||||
|
sbsd => 'Simplified BSD License',
|
||||||
|
bsl => 'Boost Software License',
|
||||||
|
catosl => 'Computer Associates Trusted Open Source License',
|
||||||
|
cddl => 'Common Development and Distribution License',
|
||||||
|
cpal => 'Common Public Attribution License',
|
||||||
|
cua => 'CUA Office Public License',
|
||||||
|
eudgsl => 'EU DataGrid Software License',
|
||||||
|
epl => 'Eclipse Public License',
|
||||||
|
ecl => 'Educational Community License',
|
||||||
|
efl => 'Eiffel Forum License',
|
||||||
|
enpl => 'Entessa Public License',
|
||||||
|
eupl => 'European Union Public License',
|
||||||
|
fair => 'Fair License',
|
||||||
|
fwl => 'Frameworx License',
|
||||||
|
gpl2 => 'GNU General Public License v2',
|
||||||
|
gpl3 => 'GNU General Public License v3',
|
||||||
|
lgpl => 'GNU Lesser General Public License',
|
||||||
|
ibm => 'IBM Public License',
|
||||||
|
ipa => 'IPA Font License',
|
||||||
|
isc => 'ISC License',
|
||||||
|
lppl => 'LaTeX Project Public License',
|
||||||
|
lpl => 'Lucent Public License',
|
||||||
|
miros => 'MirOS Licence',
|
||||||
|
mspl => 'Microsoft Public License',
|
||||||
|
msrl => 'Microsoft Reciprocal License',
|
||||||
|
mit => 'MIT License',
|
||||||
|
msl => 'Motosoto License',
|
||||||
|
mpl => 'Mozilla Public License',
|
||||||
|
mtl => 'Multics License',
|
||||||
|
nasa => 'NASA Open Source Agreement',
|
||||||
|
ntpl => 'NTP License',
|
||||||
|
naumen => 'Naumen Public License',
|
||||||
|
nhgpl => 'Nethack General Public License',
|
||||||
|
nosl => 'Nokia Open Source License',
|
||||||
|
nposl => 'Non-Profit Open Software License',
|
||||||
|
oclc => 'OCLC Research Public License',
|
||||||
|
ofl => 'Open Font License',
|
||||||
|
ogtsl => 'Open Group Test Suite License',
|
||||||
|
osl => 'Open Software License',
|
||||||
|
php => 'PHP License',
|
||||||
|
pgsql => 'The PostgreSQL License',
|
||||||
|
python => 'Python License',
|
||||||
|
pysfl => 'Python Software Foundation License',
|
||||||
|
qpl => 'Qt Public License',
|
||||||
|
real => 'RealNetworks Public Source License',
|
||||||
|
rpl => 'Reciprocal Public License',
|
||||||
|
rscpl => 'Ricoh Source Code Public License',
|
||||||
|
simple => 'Simple Public License',
|
||||||
|
scl => 'Sleepycat License',
|
||||||
|
spl => 'Sun Public License',
|
||||||
|
sowpl => 'Sybase Open Watcom Public License',
|
||||||
|
ncsa => 'University of Illinois/NCSA Open Source License',
|
||||||
|
vsl => 'Vovida Software License',
|
||||||
|
w3c => 'W3C License',
|
||||||
|
wxwll => 'wxWindows Library License',
|
||||||
|
xnet => 'X.Net License',
|
||||||
|
zpl => 'Zope Public License',
|
||||||
|
zlib => 'zlib/libpng license'
|
||||||
|
);
|
||||||
Reference in new issue
Block a user