Try again.
This commit is contained in:
Elijah Perrault committed
1 parent
92c9a64793
commit
c616931339
19 files changed
+1277
-1277
No files matched your search
@@ -8,46 +8,46 @@ PID=bin/auto.pid
|
|||||||
MODS="Class::Unload DBI"
|
MODS="Class::Unload DBI"
|
||||||
|
|
||||||
if [ "$1" = "start" ] ; then
|
if [ "$1" = "start" ] ; then
|
||||||
if [ -e $PID ]; then
|
if [ -e $PID ]; then
|
||||||
if [ "$2" = "force" ]; then
|
if [ "$2" = "force" ]; then
|
||||||
echo "Starting Auto. . ."
|
echo "Starting Auto. . ."
|
||||||
bin/auto
|
bin/auto
|
||||||
sleep 2
|
sleep 2
|
||||||
if [ ! -r $PID ]; then
|
if [ ! -r $PID ]; then
|
||||||
echo "Possible failed startup... check Auto logs for more information."
|
echo "Possible failed startup... check Auto logs for more information."
|
||||||
fi
|
fi
|
||||||
else
|
else
|
||||||
echo "Auto appears to be running already. Run ./auto start force to start anyway."
|
echo "Auto appears to be running already. Run ./auto start force to start anyway."
|
||||||
fi
|
fi
|
||||||
else
|
else
|
||||||
echo "Starting Auto. . ."
|
echo "Starting Auto. . ."
|
||||||
bin/auto
|
bin/auto
|
||||||
sleep 2
|
sleep 2
|
||||||
if [ ! -r $PID ]; then
|
if [ ! -r $PID ]; then
|
||||||
echo "Possible failed startup... check Auto logs for more information"
|
echo "Possible failed startup... check Auto logs for more information"
|
||||||
fi
|
fi
|
||||||
fi
|
fi
|
||||||
|
|
||||||
elif [ "$1" = "stop" ]; then
|
elif [ "$1" = "stop" ]; then
|
||||||
echo "Stopping Auto. . ."
|
echo "Stopping Auto. . ."
|
||||||
kill -TERM `cat $PID`
|
kill -TERM `cat $PID`
|
||||||
|
|
||||||
elif [ "$1" = "rehash" ]; then
|
elif [ "$1" = "rehash" ]; then
|
||||||
echo "Rehashing Auto. . ."
|
echo "Rehashing Auto. . ."
|
||||||
kill -HUP `cat $PID`
|
kill -HUP `cat $PID`
|
||||||
|
|
||||||
elif [ "$1" = "status" ]; then
|
elif [ "$1" = "status" ]; then
|
||||||
if [ -e $PID ]; then
|
if [ -e $PID ]; then
|
||||||
echo "Status: Auto appears to be running."
|
echo "Status: Auto appears to be running."
|
||||||
else
|
else
|
||||||
echo "Status: Auto appears to not be running."
|
echo "Status: Auto appears to not be running."
|
||||||
fi
|
fi
|
||||||
|
|
||||||
elif [ "$1" = "getmodules" ]; then
|
elif [ "$1" = "getmodules" ]; then
|
||||||
cpan -i $MODS
|
cpan -i $MODS
|
||||||
|
|
||||||
else
|
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 sw=4 ts=4:
|
||||||
@@ -23,11 +23,11 @@ BEGIN {
|
|||||||
|
|
||||||
# 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',
|
||||||
VER => 3,
|
VER => 3,
|
||||||
SVER => 0,
|
SVER => 0,
|
||||||
REV => 0,
|
REV => 0,
|
||||||
RSTAGE => 'd',
|
RSTAGE => 'd',
|
||||||
GR => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7
|
GR => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
@@ -46,7 +46,7 @@ local $PROGRAM_NAME = 'auto';
|
|||||||
|
|
||||||
# Check for build files.
|
# Check for build files.
|
||||||
if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") {
|
if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") {
|
||||||
say 'Missing build file(s). Please build Auto before running it.' and exit;
|
say 'Missing build file(s). Please build Auto before running it.' and exit;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check build OS.
|
# Check build OS.
|
||||||
@@ -54,7 +54,7 @@ open my $BFOS, '<', "$Bin/../build/os" or say 'Cannot start: Broken build.' and
|
|||||||
my @BFOS = <$BFOS>;
|
my @BFOS = <$BFOS>;
|
||||||
close $BFOS or say 'Cannot start: Broken build.' and exit;
|
close $BFOS or say 'Cannot start: Broken build.' and exit;
|
||||||
if ($BFOS[0] ne $OSNAME."\n") {
|
if ($BFOS[0] ne $OSNAME."\n") {
|
||||||
say 'Cannot start: Broken build.' and exit;
|
say 'Cannot start: Broken build.' and exit;
|
||||||
}
|
}
|
||||||
undef @BFOS;
|
undef @BFOS;
|
||||||
|
|
||||||
@@ -71,7 +71,7 @@ open my $BFPERL, '<', "$Bin/../build/perl" or say 'Cannot start: Broken build.'
|
|||||||
my @BFPERL = <$BFPERL>;
|
my @BFPERL = <$BFPERL>;
|
||||||
close $BFPERL or say 'Cannot start: Broken build.' and exit;
|
close $BFPERL or say 'Cannot start: Broken build.' and exit;
|
||||||
if ($BFPERL[0] ne $]."\n") {
|
if ($BFPERL[0] ne $]."\n") {
|
||||||
say 'Cannot start: Broken build.' and exit;
|
say 'Cannot start: Broken build.' and exit;
|
||||||
}
|
}
|
||||||
undef @BFPERL;
|
undef @BFPERL;
|
||||||
|
|
||||||
@@ -80,7 +80,7 @@ open my $BFVER, '<', "$Bin/../build/ver" or say 'Cannot start: Broken build.' an
|
|||||||
my @BFVER = <$BFVER>;
|
my @BFVER = <$BFVER>;
|
||||||
close $BFVER or say 'Cannot start: Broken build.' and exit;
|
close $BFVER or say 'Cannot start: Broken build.' and exit;
|
||||||
if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
|
if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
|
||||||
say 'Cannot start: Broken build.' and exit;
|
say 'Cannot start: Broken build.' and exit;
|
||||||
}
|
}
|
||||||
undef @BFVER;
|
undef @BFVER;
|
||||||
|
|
||||||
@@ -112,8 +112,8 @@ our ($APID, %TIMERS);
|
|||||||
our $DEBUG = 0;
|
our $DEBUG = 0;
|
||||||
our $NUC = 0;
|
our $NUC = 0;
|
||||||
if (defined $ARGV[0]) {
|
if (defined $ARGV[0]) {
|
||||||
foreach (@ARGV) {
|
foreach (@ARGV) {
|
||||||
given ($_) {
|
given ($_) {
|
||||||
when ('-d') { $DEBUG = 1; }
|
when ('-d') { $DEBUG = 1; }
|
||||||
when ('-nuc') { $NUC = 1; }
|
when ('-nuc') { $NUC = 1; }
|
||||||
}
|
}
|
||||||
@@ -135,23 +135,23 @@ our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1)
|
|||||||
say ' Success';
|
say ' Success';
|
||||||
|
|
||||||
if (conf_get('die')) {
|
if (conf_get('die')) {
|
||||||
if ((conf_get('die'))[0][0] == 1) {
|
if ((conf_get('die'))[0][0] == 1) {
|
||||||
say '!!! You didn\'t read the whole config.';
|
say '!!! You didn\'t read the whole config.';
|
||||||
say '!!! Insert new user then try again.';
|
say '!!! Insert new user then try again.';
|
||||||
exit;
|
exit;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check for required configuration values.
|
# Check for required configuration values.
|
||||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
|
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
|
||||||
foreach my $REQCVAL (@REQCVALS) {
|
foreach my $REQCVAL (@REQCVALS) {
|
||||||
if (!conf_get($REQCVAL)) {
|
if (!conf_get($REQCVAL)) {
|
||||||
my $err = 2;
|
my $err = 2;
|
||||||
if ($REQCVAL eq 'expire_logs') {
|
if ($REQCVAL eq 'expire_logs') {
|
||||||
$err = 1;
|
$err = 1;
|
||||||
}
|
}
|
||||||
err($err, "Missing required configuration value: $REQCVAL", 1);
|
err($err, "Missing required configuration value: $REQCVAL", 1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
undef @REQCVALS;
|
undef @REQCVALS;
|
||||||
|
|
||||||
@@ -253,49 +253,49 @@ Core::IRC::clear_usercmd_timer();
|
|||||||
our (%PRIVILEGES);
|
our (%PRIVILEGES);
|
||||||
# If there are any privsets.
|
# If there are any privsets.
|
||||||
if (conf_get('privset')) {
|
if (conf_get('privset')) {
|
||||||
# Get them.
|
# Get them.
|
||||||
my %tcprivs = conf_get('privset');
|
my %tcprivs = conf_get('privset');
|
||||||
|
|
||||||
foreach my $tckpriv (keys %tcprivs) {
|
foreach my $tckpriv (keys %tcprivs) {
|
||||||
# For each privset, get the inner values.
|
# For each privset, get the inner values.
|
||||||
my %mcprivs = conf_get("privset:$tckpriv");
|
my %mcprivs = conf_get("privset:$tckpriv");
|
||||||
|
|
||||||
# Iterate through them.
|
# Iterate through them.
|
||||||
foreach my $mckpriv (keys %mcprivs) {
|
foreach my $mckpriv (keys %mcprivs) {
|
||||||
# Switch statement for the values.
|
# Switch statement for the values.
|
||||||
given ($mckpriv) {
|
given ($mckpriv) {
|
||||||
# If it's 'priv', save it as a privilege.
|
# If it's 'priv', save it as a privilege.
|
||||||
when ('priv') {
|
when ('priv') {
|
||||||
if (defined $PRIVILEGES{$tckpriv}) {
|
if (defined $PRIVILEGES{$tckpriv}) {
|
||||||
# If this privset exists, push to it.
|
# If this privset exists, push to it.
|
||||||
push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
|
push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, create it.
|
# Otherwise, create it.
|
||||||
@{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
|
@{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# If it's 'inherit', inherit the privileges of another privset.
|
# If it's 'inherit', inherit the privileges of another privset.
|
||||||
when ('inherit') {
|
when ('inherit') {
|
||||||
# If the privset we're inheriting exists, continue.
|
# If the privset we're inheriting exists, continue.
|
||||||
if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
|
if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
|
||||||
# Iterate through each privilege.
|
# Iterate through each privilege.
|
||||||
foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
|
foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
|
||||||
# And save them to the privset inheriting them
|
# And save them to the privset inheriting them
|
||||||
if (defined $PRIVILEGES{$tckpriv}) {
|
if (defined $PRIVILEGES{$tckpriv}) {
|
||||||
# If this privset exists, push to it.
|
# If this privset exists, push to it.
|
||||||
push @{ $PRIVILEGES{$tckpriv} }, $_;
|
push @{ $PRIVILEGES{$tckpriv} }, $_;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, create it.
|
# Otherwise, create it.
|
||||||
@{ $PRIVILEGES{$tckpriv} } = ($_);
|
@{ $PRIVILEGES{$tckpriv} } = ($_);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Successful startup.
|
# Successful startup.
|
||||||
@@ -313,11 +313,11 @@ if (!$DEBUG) {
|
|||||||
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") {
|
if (!-e "$Bin/auto.pid") {
|
||||||
system "touch $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;
|
||||||
exit;
|
exit;
|
||||||
}
|
}
|
||||||
POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1);
|
POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1);
|
||||||
@@ -331,11 +331,11 @@ API::Std::event_add('on_preconnect');
|
|||||||
|
|
||||||
# Load modules.
|
# Load modules.
|
||||||
if (conf_get('module')) {
|
if (conf_get('module')) {
|
||||||
alog '* Loading modules...';
|
alog '* Loading modules...';
|
||||||
dbug '* Loading modules...';
|
dbug '* Loading modules...';
|
||||||
foreach (@{ (conf_get('module'))[0] }) {
|
foreach (@{ (conf_get('module'))[0] }) {
|
||||||
mod_load($_);
|
mod_load($_);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
## Create sockets.
|
## Create sockets.
|
||||||
@@ -351,13 +351,13 @@ my $it = 0;
|
|||||||
foreach my $cskey (keys %cservers) {
|
foreach my $cskey (keys %cservers) {
|
||||||
# Prepare socket data.
|
# Prepare socket data.
|
||||||
my %conndata = (
|
my %conndata = (
|
||||||
Proto => 'tcp',
|
Proto => 'tcp',
|
||||||
LocalAddr => $cservers{$cskey}{'bind'}[0],
|
LocalAddr => $cservers{$cskey}{'bind'}[0],
|
||||||
PeerAddr => $cservers{$cskey}{'host'}[0],
|
PeerAddr => $cservers{$cskey}{'host'}[0],
|
||||||
PeerPort => $cservers{$cskey}{'port'}[0],
|
PeerPort => $cservers{$cskey}{'port'}[0],
|
||||||
Timeout => 20,
|
Timeout => 20,
|
||||||
);
|
);
|
||||||
# Set IPv6/SSL data.
|
# Set IPv6/SSL data.
|
||||||
my $use6 = 0;
|
my $use6 = 0;
|
||||||
my $usessl = 0;
|
my $usessl = 0;
|
||||||
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
|
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
|
||||||
@@ -383,50 +383,50 @@ foreach my $cskey (keys %cservers) {
|
|||||||
|
|
||||||
# Create the socket.
|
# Create the socket.
|
||||||
if ($use6) {
|
if ($use6) {
|
||||||
$SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
|
$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)
|
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;
|
and delete $SOCKET{$cskey} and next;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if ($usessl) {
|
if ($usessl) {
|
||||||
$SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
|
$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)
|
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;
|
and delete $SOCKET{$cskey} and next;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
|
$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)
|
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;
|
and delete $SOCKET{$cskey} and next;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Send PASS if we have one.
|
# Send PASS if we have one.
|
||||||
if (defined $cservers{$cskey}{'pass'}[0]) {
|
if (defined $cservers{$cskey}{'pass'}[0]) {
|
||||||
socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
|
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)
|
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
||||||
and next;
|
and next;
|
||||||
}
|
}
|
||||||
API::Std::event_run('on_preconnect', $cskey);
|
API::Std::event_run('on_preconnect', $cskey);
|
||||||
# Send NICK/USER.
|
# Send NICK/USER.
|
||||||
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
|
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
|
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)
|
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
|
||||||
and next;
|
and next;
|
||||||
# Add to select.
|
# Add to select.
|
||||||
$SELECT->add($SOCKET{$cskey});
|
$SELECT->add($SOCKET{$cskey});
|
||||||
# Success!
|
# Success!
|
||||||
alog '** Successfully connected to server: '.$cskey;
|
alog '** Successfully connected to server: '.$cskey;
|
||||||
dbug '** Successfully connected to server: '.$cskey;
|
dbug '** Successfully connected to server: '.$cskey;
|
||||||
$it = 1;
|
$it = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Success!
|
# Success!
|
||||||
if ($it) {
|
if ($it) {
|
||||||
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 server connections.', 1);
|
||||||
}
|
}
|
||||||
undef $it;
|
undef $it;
|
||||||
|
|
||||||
@@ -442,40 +442,40 @@ API::Std::cmd_add('HELP', 2, 0, \%Core::Cmd::HELP_HELP, \&Core::Cmd::cmd_help);
|
|||||||
|
|
||||||
# Infinite while loop.
|
# Infinite while loop.
|
||||||
while (1) {
|
while (1) {
|
||||||
# Timer check.
|
# Timer check.
|
||||||
foreach my $tk (keys %TIMERS) {
|
foreach my $tk (keys %TIMERS) {
|
||||||
if ($TIMERS{$tk}{time} <= time) {
|
if ($TIMERS{$tk}{time} <= time) {
|
||||||
&{ $TIMERS{$tk}{sub} }();
|
&{ $TIMERS{$tk}{sub} }();
|
||||||
if ($TIMERS{$tk}{type} == 1) {
|
if ($TIMERS{$tk}{type} == 1) {
|
||||||
# If it's type 1, delete from memory.
|
# If it's type 1, delete from memory.
|
||||||
delete $TIMERS{$tk};
|
delete $TIMERS{$tk};
|
||||||
}
|
}
|
||||||
elsif ($TIMERS{$tk}{type} == 2) {
|
elsif ($TIMERS{$tk}{type} == 2) {
|
||||||
# If it's type 2, reset timer.
|
# If it's type 2, reset timer.
|
||||||
$TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
|
$TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# This should never happen.
|
# This should never happen.
|
||||||
delete $TIMERS{$tk};
|
delete $TIMERS{$tk};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# Socket check.
|
# Socket check.
|
||||||
foreach my $sock ($SELECT->can_read(1)) {
|
foreach my $sock ($SELECT->can_read(1)) {
|
||||||
# Figure out what network is sending us data.
|
# Figure out what network is sending us data.
|
||||||
my $sockid;
|
my $sockid;
|
||||||
foreach (keys %SOCKET) {
|
foreach (keys %SOCKET) {
|
||||||
if ($SOCKET{$_} eq $sock) { $sockid = $_; }
|
if ($SOCKET{$_} eq $sock) { $sockid = $_; }
|
||||||
}
|
}
|
||||||
# Read the data.
|
# Read the data.
|
||||||
my $idata;
|
my $idata;
|
||||||
sysread $sock, $idata, POSIX::BUFSIZ, 0;
|
sysread $sock, $idata, POSIX::BUFSIZ, 0;
|
||||||
|
|
||||||
# Check for the data.
|
# Check for the data.
|
||||||
if (!defined $idata || length($idata) == 0) {
|
if (!defined $idata || length($idata) == 0) {
|
||||||
# Got EOF, close socket
|
# Got EOF, close socket
|
||||||
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};
|
||||||
if (!keys %SOCKET) {
|
if (!keys %SOCKET) {
|
||||||
# No more connections, stop the program.
|
# No more connections, stop the program.
|
||||||
@@ -486,22 +486,22 @@ while (1) {
|
|||||||
exit;
|
exit;
|
||||||
}
|
}
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Read the buffer.
|
# Read the buffer.
|
||||||
my $data .= $idata;
|
my $data .= $idata;
|
||||||
while ($data =~ s/(.*\n)//) {
|
while ($data =~ s/(.*\n)//) {
|
||||||
my $line = $1;
|
my $line = $1;
|
||||||
|
|
||||||
# Remove the newlines.
|
# Remove the newlines.
|
||||||
chomp $line;
|
chomp $line;
|
||||||
# Debug.
|
# Debug.
|
||||||
dbug $sockid.' >> '.$line;
|
dbug $sockid.' >> '.$line;
|
||||||
|
|
||||||
# Parse data.
|
# Parse data.
|
||||||
Parser::IRC::ircparse($sockid, $line);
|
Parser::IRC::ircparse($sockid, $line);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
###############
|
###############
|
||||||
@@ -511,16 +511,16 @@ 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."\n", POSIX::BUFSIZ, 0;
|
||||||
dbug "$svr << $data";
|
dbug "$svr << $data";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Load a module.
|
# Load a module.
|
||||||
|
|||||||
@@ -19,18 +19,18 @@ our $ERROR = 0;
|
|||||||
# Iterate through the arguments passed to us.
|
# Iterate through the arguments passed to us.
|
||||||
my $features = 'base ssl sqlite';
|
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;
|
||||||
}
|
}
|
||||||
@@ -40,13 +40,13 @@ if (defined $ARGV[0]) {
|
|||||||
elsif ($_ eq '--with-mysql') {
|
elsif ($_ eq '--with-mysql') {
|
||||||
$features =~ s/(sqlite|pgsql)/mysql/g;
|
$features =~ s/(sqlite|pgsql)/mysql/g;
|
||||||
}
|
}
|
||||||
elsif ($_ eq '--with-pgsql') {
|
elsif ($_ eq '--with-pgsql') {
|
||||||
$features =~ s/(sqlite|mysql)/pgsql/g;
|
$features =~ s/(sqlite|mysql)/pgsql/g;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
println "Warning: Unknown option '$_'";
|
println "Warning: Unknown option '$_'";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check Perl version.
|
# Check Perl version.
|
||||||
@@ -58,32 +58,32 @@ eval {
|
|||||||
# Check operating system.
|
# Check operating system.
|
||||||
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";
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "MSWin32") {
|
elsif ($OSNAME eq "MSWin32") {
|
||||||
print "Microsoft Windows is not supported. Support is planned for the future.\r\n";
|
print "Microsoft Windows is not supported. Support is planned for the future.\r\n";
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "NetWare") {
|
elsif ($OSNAME eq "NetWare") {
|
||||||
print "NetWare is not supported.\r\n";
|
print "NetWare is not supported.\r\n";
|
||||||
}
|
}
|
||||||
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";
|
||||||
}
|
}
|
||||||
elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
|
elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
|
||||||
print "OK\r";
|
print "OK\r";
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "freebsd") {
|
elsif ($OSNAME eq "freebsd") {
|
||||||
print "OK\n";
|
print "OK\n";
|
||||||
}
|
}
|
||||||
elsif ($OSNAME eq "openbsd") {
|
elsif ($OSNAME eq "openbsd") {
|
||||||
print "OK\n";
|
print "OK\n";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
print "Unknown operating system. Contact support.\r\n";
|
print "Unknown operating system. Contact support.\r\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check for Perl core modules.
|
# Check for Perl core modules.
|
||||||
println "Checking for core Perl modules.....";
|
println "Checking for core Perl modules.....";
|
||||||
@@ -124,19 +124,19 @@ else {
|
|||||||
println "\0";
|
println "\0";
|
||||||
println "Building.....";
|
println "Building.....";
|
||||||
if (!-d "$Bin/build") {
|
if (!-d "$Bin/build") {
|
||||||
system "mkdir $Bin/build";
|
system "mkdir $Bin/build";
|
||||||
}
|
}
|
||||||
if (!-e "$Bin/build/time") {
|
if (!-e "$Bin/build/time") {
|
||||||
system "touch $Bin/build/time";
|
system "touch $Bin/build/time";
|
||||||
}
|
}
|
||||||
if (!-e "$Bin/build/os") {
|
if (!-e "$Bin/build/os") {
|
||||||
system "touch $Bin/build/os";
|
system "touch $Bin/build/os";
|
||||||
}
|
}
|
||||||
if (!-e "$Bin/build/perl") {
|
if (!-e "$Bin/build/perl") {
|
||||||
system "touch $Bin/build/perl";
|
system "touch $Bin/build/perl";
|
||||||
}
|
}
|
||||||
if (!-e "$Bin/build/ver") {
|
if (!-e "$Bin/build/ver") {
|
||||||
system "touch $Bin/build/ver";
|
system "touch $Bin/build/ver";
|
||||||
}
|
}
|
||||||
|
|
||||||
build($features);
|
build($features);
|
||||||
|
|||||||
+88
-88
@@ -48,68 +48,68 @@ sub ban
|
|||||||
# Join a channel.
|
# Join a channel.
|
||||||
sub cjoin
|
sub cjoin
|
||||||
{
|
{
|
||||||
my ($svr, $chan, $key) = @_;
|
my ($svr, $chan, $key) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan"));
|
Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan"));
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Part a channel.
|
# Part a channel.
|
||||||
sub cpart
|
sub cpart
|
||||||
{
|
{
|
||||||
my ($svr, $chan, $reason) = @_;
|
my ($svr, $chan, $reason) = @_;
|
||||||
|
|
||||||
if (defined $reason) {
|
if (defined $reason) {
|
||||||
Auto::socksnd($svr, "PART $chan :$reason");
|
Auto::socksnd($svr, "PART $chan :$reason");
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
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}; }
|
if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; }
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Set mode(s) on a channel.
|
# Set mode(s) on a channel.
|
||||||
sub cmode
|
sub cmode
|
||||||
{
|
{
|
||||||
my ($svr, $chan, $modes) = @_;
|
my ($svr, $chan, $modes) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "MODE $chan $modes");
|
Auto::socksnd($svr, "MODE $chan $modes");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Set mode(s) on us.
|
# Set mode(s) on us.
|
||||||
sub umode
|
sub umode
|
||||||
{
|
{
|
||||||
my ($svr, $modes) = @_;
|
my ($svr, $modes) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
|
Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Send a PRIVMSG.
|
# Send a PRIVMSG.
|
||||||
sub privmsg
|
sub privmsg
|
||||||
{
|
{
|
||||||
my ($svr, $target, $message) = @_;
|
my ($svr, $target, $message) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "PRIVMSG $target :$message");
|
Auto::socksnd($svr, "PRIVMSG $target :$message");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Send a NOTICE.
|
# Send a NOTICE.
|
||||||
sub notice
|
sub notice
|
||||||
{
|
{
|
||||||
my ($svr, $target, $message) = @_;
|
my ($svr, $target, $message) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "NOTICE $target :$message");
|
Auto::socksnd($svr, "NOTICE $target :$message");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Send an ACTION PRIVMSG.
|
# Send an ACTION PRIVMSG.
|
||||||
@@ -125,33 +125,33 @@ sub act
|
|||||||
# Change bot nickname.
|
# Change bot nickname.
|
||||||
sub nick
|
sub nick
|
||||||
{
|
{
|
||||||
my ($svr, $newnick) = @_;
|
my ($svr, $newnick) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "NICK $newnick");
|
Auto::socksnd($svr, "NICK $newnick");
|
||||||
|
|
||||||
$Parser::IRC::botnick{$svr}{newnick} = $newnick;
|
$Parser::IRC::botnick{$svr}{newnick} = $newnick;
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Request the users of a channel.
|
# Request the users of a channel.
|
||||||
sub names
|
sub names
|
||||||
{
|
{
|
||||||
my ($svr, $chan) = @_;
|
my ($svr, $chan) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "NAMES $chan");
|
Auto::socksnd($svr, "NAMES $chan");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Send a topic to the channel.
|
# Send a topic to the channel.
|
||||||
sub topic
|
sub topic
|
||||||
{
|
{
|
||||||
my ($svr, $chan, $topic) = @_;
|
my ($svr, $chan, $topic) = @_;
|
||||||
|
|
||||||
Auto::socksnd($svr, "TOPIC $chan :$topic");
|
Auto::socksnd($svr, "TOPIC $chan :$topic");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Kick a user.
|
# Kick a user.
|
||||||
@@ -167,54 +167,54 @@ 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});
|
delete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr});
|
||||||
delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr});
|
delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr});
|
||||||
|
|
||||||
return 1;
|
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
|
||||||
{
|
{
|
||||||
my ($ex) = @_;
|
my ($ex) = @_;
|
||||||
|
|
||||||
my @si = split('!', $ex);
|
my @si = split('!', $ex);
|
||||||
my @sii = split('@', $si[1]);
|
my @sii = split('@', $si[1]);
|
||||||
|
|
||||||
return (
|
return (
|
||||||
nick => $si[0],
|
nick => $si[0],
|
||||||
user => $sii[0],
|
user => $sii[0],
|
||||||
host => $sii[1]
|
host => $sii[1]
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
# Match two IRC masks.
|
# Match two IRC masks.
|
||||||
sub match_mask
|
sub match_mask
|
||||||
{
|
{
|
||||||
my ($mu, $mh) = @_;
|
my ($mu, $mh) = @_;
|
||||||
|
|
||||||
# Prepare the regex.
|
# Prepare the regex.
|
||||||
$mh =~ s/\./\\\./g;
|
$mh =~ s/\./\\\./g;
|
||||||
$mh =~ s/\?/\./g;
|
$mh =~ s/\?/\./g;
|
||||||
$mh =~ s/\*/\.\*/g;
|
$mh =~ s/\*/\.\*/g;
|
||||||
$mh = '^'.$mh.'$';
|
$mh = '^'.$mh.'$';
|
||||||
|
|
||||||
# Let's grep the user's mask.
|
# Let's grep the user's mask.
|
||||||
if (grep(/$mh/, $mu)) {
|
if (grep(/$mh/, $mu)) {
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+55
-55
@@ -18,11 +18,11 @@ our @EXPORT_OK = qw(println dbug alog slog);
|
|||||||
# Print with the system newline appended.
|
# Print with the system newline appended.
|
||||||
sub println
|
sub println
|
||||||
{
|
{
|
||||||
my ($out) = @_;
|
my ($out) = @_;
|
||||||
|
|
||||||
if (!defined $out) {
|
if (!defined $out) {
|
||||||
print $RS;
|
print $RS;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
print $out.$RS;
|
print $out.$RS;
|
||||||
}
|
}
|
||||||
@@ -33,79 +33,79 @@ sub println
|
|||||||
# Print only if in debug mode.
|
# Print only if in debug mode.
|
||||||
sub dbug
|
sub dbug
|
||||||
{
|
{
|
||||||
my ($out) = @_;
|
my ($out) = @_;
|
||||||
|
|
||||||
if ($Auto::DEBUG) {
|
if ($Auto::DEBUG) {
|
||||||
# We're in debug mode; print it out.
|
# We're in debug mode; print it out.
|
||||||
say $out;
|
say $out;
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Log to file.
|
# Log to file.
|
||||||
sub alog
|
sub alog
|
||||||
{
|
{
|
||||||
my ($lmsg) = @_;
|
my ($lmsg) = @_;
|
||||||
|
|
||||||
# Expire old logs first.
|
# Expire old logs first.
|
||||||
expire_logs();
|
expire_logs();
|
||||||
|
|
||||||
# Get date and time in the desired format.
|
# Get date and time in the desired format.
|
||||||
my $date = POSIX::strftime('%Y%m%d', localtime);
|
my $date = POSIX::strftime('%Y%m%d', localtime);
|
||||||
my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
|
my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
|
||||||
|
|
||||||
# Create var/ if it doesn't exist.
|
# Create var/ if it doesn't exist.
|
||||||
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.
|
# Create var/DATE.log if it doesn't exist.
|
||||||
if (!-e "$Auto::Bin/../var/$date.log") {
|
if (!-e "$Auto::Bin/../var/$date.log") {
|
||||||
system "touch $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;
|
||||||
print {$FLOG} "[$time] $lmsg\n" or return;
|
print {$FLOG} "[$time] $lmsg\n" or return;
|
||||||
close $FLOG or return;
|
close $FLOG or return;
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Expire old logs.
|
# Expire old logs.
|
||||||
sub expire_logs
|
sub expire_logs
|
||||||
{
|
{
|
||||||
# Get configuration value.
|
# Get configuration value.
|
||||||
my $celog = (conf_get('expire_logs'))[0][0] or return;
|
my $celog = (conf_get('expire_logs'))[0][0] or return;
|
||||||
|
|
||||||
# Check for invalid values.
|
# Check for invalid values.
|
||||||
if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
# Must be numbers only.
|
# Must be numbers only.
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
elsif (!$celog) {
|
elsif (!$celog) {
|
||||||
# No expire.
|
# No expire.
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Iterate through each logfile.
|
# Iterate through each logfile.
|
||||||
foreach my $file (glob "$Auto::Bin/../var/*") {
|
foreach my $file (glob "$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.
|
||||||
my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||||
my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||||
$mm = $mm - 1;
|
$mm = $mm - 1;
|
||||||
my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||||
my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
|
my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
|
||||||
|
|
||||||
# If it's older than <config_value> days, delete it.
|
# If it's older than <config_value> days, delete it.
|
||||||
if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||||
unlink "$Auto::Bin/../var/$file";
|
unlink "$Auto::Bin/../var/$file";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Subroutine for logging to an IRC logchan.
|
# Subroutine for logging to an IRC logchan.
|
||||||
|
|||||||
+263
-263
@@ -11,237 +11,237 @@ use base qw(Exporter);
|
|||||||
|
|
||||||
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
|
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
|
||||||
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);
|
||||||
|
|
||||||
|
|
||||||
# Initialize a module.
|
# Initialize a module.
|
||||||
sub mod_init
|
sub mod_init
|
||||||
{
|
{
|
||||||
my ($name, $author, $version, $autover, $pkg) = @_;
|
my ($name, $author, $version, $autover, $pkg) = @_;
|
||||||
|
|
||||||
# Log/debug.
|
# Log/debug.
|
||||||
API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||||
API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); }
|
||||||
|
|
||||||
# Check if this module is compatible with this version of Auto.
|
# 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 ne '3.0.0a4' and $autover ne '3.0.0a5') {
|
||||||
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.'); }
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Run the module's _init sub.
|
# Run the module's _init sub.
|
||||||
my $mi = eval($pkg.'::_init();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
my $mi = eval($pkg.'::_init();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
||||||
|
|
||||||
if ($mi) {
|
if ($mi) {
|
||||||
# If successful, add to hash.
|
# If successful, add to hash.
|
||||||
$MODULE{$name}{name} = $name;
|
$MODULE{$name}{name} = $name;
|
||||||
$MODULE{$name}{version} = $version;
|
$MODULE{$name}{version} = $version;
|
||||||
$MODULE{$name}{author} = $author;
|
$MODULE{$name}{author} = $author;
|
||||||
$MODULE{$name}{pkg} = $pkg;
|
$MODULE{$name}{pkg} = $pkg;
|
||||||
|
|
||||||
API::Log::dbug('MODULES: '.$name.' successfully loaded.');
|
API::Log::dbug('MODULES: '.$name.' successfully loaded.');
|
||||||
API::Log::alog('MODULES: '.$name.' successfully loaded.');
|
API::Log::alog('MODULES: '.$name.' successfully loaded.');
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.'); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.'); }
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, return a failed to load message.
|
# Otherwise, return a failed to load message.
|
||||||
API::Log::dbug('MODULES: Failed to load '.$name.q{.});
|
API::Log::dbug('MODULES: Failed to load '.$name.q{.});
|
||||||
API::Log::alog('MODULES: Failed to load '.$name.q{.});
|
API::Log::alog('MODULES: Failed to load '.$name.q{.});
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}); }
|
||||||
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check if a module exists.
|
# Check if a module exists.
|
||||||
sub mod_exists
|
sub mod_exists
|
||||||
{
|
{
|
||||||
my ($name) = @_;
|
my ($name) = @_;
|
||||||
|
|
||||||
if (defined $API::Std::MODULE{$name}) { return 1; }
|
if (defined $API::Std::MODULE{$name}) { return 1; }
|
||||||
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Void a module.
|
# Void a module.
|
||||||
sub mod_void
|
sub mod_void
|
||||||
{
|
{
|
||||||
my ($module) = @_;
|
my ($module) = @_;
|
||||||
|
|
||||||
# Log/debug.
|
# Log/debug.
|
||||||
API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
|
API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
|
||||||
API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
|
API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...'); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...'); }
|
||||||
|
|
||||||
# Check if this module exists.
|
# Check if this module exists.
|
||||||
if (!defined $MODULE{$module}) {
|
if (!defined $MODULE{$module}) {
|
||||||
API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
|
API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
|
||||||
API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
|
API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?'); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?'); }
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Run the module's _void sub.
|
# Run the module's _void sub.
|
||||||
my $mi = eval($MODULE{$module}{pkg}.'::_void();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
my $mi = eval($MODULE{$module}{pkg}.'::_void();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
||||||
|
|
||||||
if ($mi) {
|
if ($mi) {
|
||||||
# If successful, delete class from program and delete module from hash.
|
# If successful, delete class from program and delete module from hash.
|
||||||
Class::Unload->unload($MODULE{$module}{pkg});
|
Class::Unload->unload($MODULE{$module}{pkg});
|
||||||
delete $MODULE{$module};
|
delete $MODULE{$module};
|
||||||
API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
|
API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
|
||||||
API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
|
API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}); }
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, return a failed to unload message.
|
# Otherwise, return a failed to unload message.
|
||||||
API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
|
API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
|
||||||
API::Log::alog('MODULES: Failed to unload '.$module.q{.});
|
API::Log::alog('MODULES: Failed to unload '.$module.q{.});
|
||||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}); }
|
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}); }
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Add a command to Auto.
|
# Add a command to Auto.
|
||||||
sub cmd_add
|
sub cmd_add
|
||||||
{
|
{
|
||||||
my ($cmd, $lvl, $priv, $help, $sub) = @_;
|
my ($cmd, $lvl, $priv, $help, $sub) = @_;
|
||||||
$cmd = uc $cmd;
|
$cmd = uc $cmd;
|
||||||
|
|
||||||
if (defined $API::Std::CMDS{$cmd}) { return; }
|
if (defined $API::Std::CMDS{$cmd}) { return; }
|
||||||
if ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
|
|
||||||
$API::Std::CMDS{$cmd}{lvl} = $lvl;
|
$API::Std::CMDS{$cmd}{lvl} = $lvl;
|
||||||
$API::Std::CMDS{$cmd}{help} = $help;
|
$API::Std::CMDS{$cmd}{help} = $help;
|
||||||
$API::Std::CMDS{$cmd}{priv} = $priv;
|
$API::Std::CMDS{$cmd}{priv} = $priv;
|
||||||
$API::Std::CMDS{$cmd}{'sub'} = $sub;
|
$API::Std::CMDS{$cmd}{'sub'} = $sub;
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# Delete a command from Auto.
|
# Delete a command from Auto.
|
||||||
sub cmd_del
|
sub cmd_del
|
||||||
{
|
{
|
||||||
my ($cmd) = @_;
|
my ($cmd) = @_;
|
||||||
$cmd = uc $cmd;
|
$cmd = uc $cmd;
|
||||||
|
|
||||||
if (defined $API::Std::CMDS{$cmd}) {
|
if (defined $API::Std::CMDS{$cmd}) {
|
||||||
delete $API::Std::CMDS{$cmd};
|
delete $API::Std::CMDS{$cmd};
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Add an event to Auto.
|
# Add an event to Auto.
|
||||||
sub event_add
|
sub event_add
|
||||||
{
|
{
|
||||||
my ($name) = @_;
|
my ($name) = @_;
|
||||||
|
|
||||||
if (!defined $EVENTS{lc $name}) {
|
if (!defined $EVENTS{lc $name}) {
|
||||||
$EVENTS{lc $name} = 1;
|
$EVENTS{lc $name} = 1;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...');
|
API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...');
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Delete an event from Auto.
|
# Delete an event from Auto.
|
||||||
sub event_del
|
sub event_del
|
||||||
{
|
{
|
||||||
my ($name) = @_;
|
my ($name) = @_;
|
||||||
|
|
||||||
if (defined $EVENTS{lc $name}) {
|
if (defined $EVENTS{lc $name}) {
|
||||||
delete $EVENTS{lc $name};
|
delete $EVENTS{lc $name};
|
||||||
delete $HOOKS{lc $name};
|
delete $HOOKS{lc $name};
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...');
|
API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...');
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Trigger an event.
|
# Trigger an event.
|
||||||
sub event_run
|
sub event_run
|
||||||
{
|
{
|
||||||
my ($event, @args) = @_;
|
my ($event, @args) = @_;
|
||||||
|
|
||||||
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
|
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
|
||||||
foreach my $hk (keys %{ $HOOKS{lc $event} }) {
|
foreach my $hk (keys %{ $HOOKS{lc $event} }) {
|
||||||
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
|
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
|
||||||
if ($ri == -1) { last; }
|
if ($ri == -1) { last; }
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Add a hook to Auto.
|
# Add a hook to Auto.
|
||||||
sub hook_add
|
sub hook_add
|
||||||
{
|
{
|
||||||
my ($event, $name, $sub) = @_;
|
my ($event, $name, $sub) = @_;
|
||||||
|
|
||||||
if (!defined $API::Std::HOOKS{lc $name}) {
|
if (!defined $API::Std::HOOKS{lc $name}) {
|
||||||
if (defined $API::Std::EVENTS{lc $event}) {
|
if (defined $API::Std::EVENTS{lc $event}) {
|
||||||
$API::Std::HOOKS{lc $event}{lc $name} = $sub;
|
$API::Std::HOOKS{lc $event}{lc $name} = $sub;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Delete a hook from Auto.
|
# Delete a hook from Auto.
|
||||||
sub hook_del
|
sub hook_del
|
||||||
{
|
{
|
||||||
my ($event, $name) = @_;
|
my ($event, $name) = @_;
|
||||||
|
|
||||||
if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
|
if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
|
||||||
delete $API::Std::HOOKS{lc $event}{lc $name};
|
delete $API::Std::HOOKS{lc $event}{lc $name};
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Add a timer to Auto.
|
# Add a timer to Auto.
|
||||||
sub timer_add
|
sub timer_add
|
||||||
{
|
{
|
||||||
my ($name, $type, $time, $sub) = @_;
|
my ($name, $type, $time, $sub) = @_;
|
||||||
$name = lc $name;
|
$name = lc $name;
|
||||||
|
|
||||||
# Check for invalid type/time.
|
# Check for invalid type/time.
|
||||||
if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!defined $Auto::TIMERS{$name}) {
|
if (!defined $Auto::TIMERS{$name}) {
|
||||||
$Auto::TIMERS{$name}{type} = $type;
|
$Auto::TIMERS{$name}{type} = $type;
|
||||||
$Auto::TIMERS{$name}{time} = time + $time;
|
$Auto::TIMERS{$name}{time} = time + $time;
|
||||||
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
|
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
|
||||||
$Auto::TIMERS{$name}{sub} = $sub;
|
$Auto::TIMERS{$name}{sub} = $sub;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -249,123 +249,123 @@ sub timer_add
|
|||||||
# Delete a timer from Auto.
|
# Delete a timer from Auto.
|
||||||
sub timer_del
|
sub timer_del
|
||||||
{
|
{
|
||||||
my ($name) = @_;
|
my ($name) = @_;
|
||||||
$name = lc $name;
|
$name = lc $name;
|
||||||
|
|
||||||
if (defined $Auto::TIMERS{$name}) {
|
if (defined $Auto::TIMERS{$name}) {
|
||||||
delete $Auto::TIMERS{$name};
|
delete $Auto::TIMERS{$name};
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Hook onto a raw command.
|
# Hook onto a raw command.
|
||||||
sub rchook_add
|
sub rchook_add
|
||||||
{
|
{
|
||||||
my ($cmd, $sub) = @_;
|
my ($cmd, $sub) = @_;
|
||||||
$cmd = uc $cmd;
|
$cmd = uc $cmd;
|
||||||
|
|
||||||
if (defined $Parser::IRC::RAWC{$cmd}) { return; }
|
if (defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||||
|
|
||||||
$Parser::IRC::RAWC{$cmd} = $sub;
|
$Parser::IRC::RAWC{$cmd} = $sub;
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Delete a raw command hook.
|
# Delete a raw command hook.
|
||||||
sub rchook_del
|
sub rchook_del
|
||||||
{
|
{
|
||||||
my ($cmd) = @_;
|
my ($cmd) = @_;
|
||||||
$cmd = uc $cmd;
|
$cmd = uc $cmd;
|
||||||
|
|
||||||
if (!defined $Parser::IRC::RAWC{$cmd}) { return; }
|
if (!defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||||
|
|
||||||
delete $Parser::IRC::RAWC{$cmd};
|
delete $Parser::IRC::RAWC{$cmd};
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Configuration value getter.
|
# Configuration value getter.
|
||||||
sub conf_get
|
sub conf_get
|
||||||
{
|
{
|
||||||
my ($value) = @_;
|
my ($value) = @_;
|
||||||
|
|
||||||
# Create an array out of the value.
|
# Create an array out of the value.
|
||||||
my @val;
|
my @val;
|
||||||
if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
@val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
@val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
@val = ($value);
|
@val = ($value);
|
||||||
}
|
}
|
||||||
# Undefine this as it's unnecessary now.
|
# Undefine this as it's unnecessary now.
|
||||||
undef $value;
|
undef $value;
|
||||||
|
|
||||||
# Get the count of elements in the array.
|
# Get the count of elements in the array.
|
||||||
my $count = scalar @val;
|
my $count = scalar @val;
|
||||||
|
|
||||||
# Return the requested configuration value(s).
|
# Return the requested configuration value(s).
|
||||||
if ($count == 1) {
|
if ($count == 1) {
|
||||||
if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') {
|
if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') {
|
||||||
return %{ $Auto::SETTINGS{$val[0]} };
|
return %{ $Auto::SETTINGS{$val[0]} };
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $Auto::SETTINGS{$val[0]};
|
return $Auto::SETTINGS{$val[0]};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($count == 2) {
|
elsif ($count == 2) {
|
||||||
if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') {
|
if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') {
|
||||||
return %{ $Auto::SETTINGS{$val[0]}{$val[1]} };
|
return %{ $Auto::SETTINGS{$val[0]}{$val[1]} };
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $Auto::SETTINGS{$val[0]}{$val[1]};
|
return $Auto::SETTINGS{$val[0]}{$val[1]};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($count == 3) {
|
elsif ($count == 3) {
|
||||||
if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') {
|
if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') {
|
||||||
return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} };
|
return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} };
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]};
|
return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Translation subroutine.
|
# Translation subroutine.
|
||||||
sub trans
|
sub trans
|
||||||
{
|
{
|
||||||
my $id = shift;
|
my $id = shift;
|
||||||
$id =~ s/ /_/gsm;
|
$id =~ s/ /_/gsm;
|
||||||
|
|
||||||
if (defined $API::Std::LANGE{$id}) {
|
if (defined $API::Std::LANGE{$id}) {
|
||||||
return sprintf $API::Std::LANGE{$id}, @_;
|
return sprintf $API::Std::LANGE{$id}, @_;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$id =~ s/_/ /gsm;
|
$id =~ s/_/ /gsm;
|
||||||
return $id;
|
return $id;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Match user subroutine.
|
# Match user subroutine.
|
||||||
sub match_user
|
sub match_user
|
||||||
{
|
{
|
||||||
my (%user) = @_;
|
my (%user) = @_;
|
||||||
|
|
||||||
# Get data from config.
|
# Get data from config.
|
||||||
if (!conf_get('user')) { return; }
|
if (!conf_get('user')) { return; }
|
||||||
my %uhp = conf_get('user');
|
my %uhp = conf_get('user');
|
||||||
|
|
||||||
foreach my $userkey (keys %uhp) {
|
foreach my $userkey (keys %uhp) {
|
||||||
# For each user block.
|
# For each user block.
|
||||||
my %ulhp = %{ $uhp{$userkey} };
|
my %ulhp = %{ $uhp{$userkey} };
|
||||||
foreach my $uhk (keys %ulhp) {
|
foreach my $uhk (keys %ulhp) {
|
||||||
# For each user.
|
# For each user.
|
||||||
|
|
||||||
if ($uhk eq 'net') {
|
if ($uhk eq 'net') {
|
||||||
if (defined $user{svr}) {
|
if (defined $user{svr}) {
|
||||||
if (lc $user{svr} ne lc(($ulhp{$uhk})[0][0])) {
|
if (lc $user{svr} ne lc(($ulhp{$uhk})[0][0])) {
|
||||||
# config.user:net conflicts with irc.user:svr.
|
# config.user:net conflicts with irc.user:svr.
|
||||||
@@ -374,13 +374,13 @@ sub match_user
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($uhk eq 'mask') {
|
elsif ($uhk eq 'mask') {
|
||||||
# Put together the user information.
|
# Put together the user information.
|
||||||
my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
|
my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
|
||||||
if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
|
if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
|
||||||
# We've got a host match.
|
# We've got a host match.
|
||||||
return $userkey;
|
return $userkey;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($uhk eq 'chanstatus' and defined $ulhp{'net'}) {
|
elsif ($uhk eq 'chanstatus' and defined $ulhp{'net'}) {
|
||||||
my ($ccst, $ccnm) = split m/[:]/sm, ($ulhp{$uhk})[0][0]; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
my ($ccst, $ccnm) = split m/[:]/sm, ($ulhp{$uhk})[0][0]; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
my $svr = $ulhp{net}[0];
|
my $svr = $ulhp{net}[0];
|
||||||
@@ -401,28 +401,28 @@ sub match_user
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Privilege subroutine.
|
# Privilege subroutine.
|
||||||
sub has_priv
|
sub has_priv
|
||||||
{
|
{
|
||||||
my ($cuser, $cpriv) = @_;
|
my ($cuser, $cpriv) = @_;
|
||||||
|
|
||||||
if (conf_get("user:$cuser:privs")) {
|
if (conf_get("user:$cuser:privs")) {
|
||||||
my $cups = (conf_get("user:$cuser:privs"))[0][0];
|
my $cups = (conf_get("user:$cuser:privs"))[0][0];
|
||||||
|
|
||||||
if (defined $Auto::PRIVILEGES{$cups}) {
|
if (defined $Auto::PRIVILEGES{$cups}) {
|
||||||
foreach (@{ $Auto::PRIVILEGES{$cups} }) {
|
foreach (@{ $Auto::PRIVILEGES{$cups} }) {
|
||||||
if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
|
if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Ratelimit check subroutine.
|
# Ratelimit check subroutine.
|
||||||
@@ -461,59 +461,59 @@ sub ratelimit_check
|
|||||||
# Error subroutine.
|
# Error subroutine.
|
||||||
sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
|
sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
|
||||||
{
|
{
|
||||||
my ($lvl, $msg, $fatal) = @_;
|
my ($lvl, $msg, $fatal) = @_;
|
||||||
|
|
||||||
# Check for an invalid level.
|
# Check for an invalid level.
|
||||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Level 1: Print to screen.
|
# Level 1: Print to screen.
|
||||||
if ($lvl >= 1) {
|
if ($lvl >= 1) {
|
||||||
say "ERROR: $msg";
|
say "ERROR: $msg";
|
||||||
}
|
}
|
||||||
# Level 2: Log to file.
|
# Level 2: Log to file.
|
||||||
if ($lvl >= 2) {
|
if ($lvl >= 2) {
|
||||||
API::Log::alog("ERROR: $msg");
|
API::Log::alog("ERROR: $msg");
|
||||||
}
|
}
|
||||||
# Level 3: Log to IRC.
|
# Level 3: Log to IRC.
|
||||||
if ($lvl >= 3) {
|
if ($lvl >= 3) {
|
||||||
API::Log::slog("ERROR: $msg");
|
API::Log::slog("ERROR: $msg");
|
||||||
}
|
}
|
||||||
|
|
||||||
# If it's a fatal error, exit the program.
|
# If it's a fatal error, exit the program.
|
||||||
if ($fatal) { exit; }
|
if ($fatal) { exit; }
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Warn subroutine.
|
# Warn subroutine.
|
||||||
sub awarn
|
sub awarn
|
||||||
{
|
{
|
||||||
my ($lvl, $msg) = @_;
|
my ($lvl, $msg) = @_;
|
||||||
|
|
||||||
# Check for an invalid level.
|
# Check for an invalid level.
|
||||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Level 1: Print to screen.
|
# Level 1: Print to screen.
|
||||||
if ($lvl >= 1) {
|
if ($lvl >= 1) {
|
||||||
say "WARNING: $msg";
|
say "WARNING: $msg";
|
||||||
}
|
}
|
||||||
# Level 2: Log to file.
|
# Level 2: Log to file.
|
||||||
if ($lvl >= 2) {
|
if ($lvl >= 2) {
|
||||||
API::Log::alog("WARNING: $msg");
|
API::Log::alog("WARNING: $msg");
|
||||||
}
|
}
|
||||||
# Level 3: Log to IRC.
|
# Level 3: Log to IRC.
|
||||||
if ($lvl >= 3) {
|
if ($lvl >= 3) {
|
||||||
API::Log::slog("WARNING: $msg");
|
API::Log::slog("WARNING: $msg");
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+21
-21
@@ -43,22 +43,22 @@ hook_add("on_quit", "quit_update_chanusers", sub {
|
|||||||
hook_add("on_connect", "on_connect_modes", sub {
|
hook_add("on_connect", "on_connect_modes", sub {
|
||||||
my ($svr) = @_;
|
my ($svr) = @_;
|
||||||
|
|
||||||
if (conf_get("server:$svr:modes")) {
|
if (conf_get("server:$svr:modes")) {
|
||||||
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
||||||
API::IRC::umode($svr, $connmodes);
|
API::IRC::umode($svr, $connmodes);
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
});
|
});
|
||||||
|
|
||||||
# Plaintext auth.
|
# Plaintext auth.
|
||||||
hook_add("on_connect", "plaintext_auth", sub {
|
hook_add("on_connect", "plaintext_auth", sub {
|
||||||
my ($svr) = @_;
|
my ($svr) = @_;
|
||||||
|
|
||||||
if (conf_get("server:$svr:idstr")) {
|
if (conf_get("server:$svr:idstr")) {
|
||||||
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
||||||
Auto::socksnd($svr, $idstr);
|
Auto::socksnd($svr, $idstr);
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
});
|
});
|
||||||
@@ -67,14 +67,14 @@ hook_add("on_connect", "plaintext_auth", sub {
|
|||||||
hook_add("on_connect", "autojoin", sub {
|
hook_add("on_connect", "autojoin", sub {
|
||||||
my ($svr) = @_;
|
my ($svr) = @_;
|
||||||
|
|
||||||
# Get the auto-join from the config.
|
# Get the auto-join from the config.
|
||||||
my @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] };
|
my @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] };
|
||||||
|
|
||||||
# Join the channels.
|
# Join the channels.
|
||||||
if (!defined $cajoin[1]) {
|
if (!defined $cajoin[1]) {
|
||||||
# For single-line ajoins.
|
# For single-line ajoins.
|
||||||
my @sajoin = split(',', $cajoin[0]);
|
my @sajoin = split(',', $cajoin[0]);
|
||||||
|
|
||||||
foreach (@sajoin) {
|
foreach (@sajoin) {
|
||||||
# Check if a key was specified.
|
# Check if a key was specified.
|
||||||
if ($_ =~ m/\s/xsm) {
|
if ($_ =~ m/\s/xsm) {
|
||||||
@@ -84,13 +84,13 @@ hook_add("on_connect", "autojoin", sub {
|
|||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Else join without one.
|
# Else join without one.
|
||||||
API::IRC::cjoin($svr, $_);
|
API::IRC::cjoin($svr, $_);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# For multi-line ajoins.
|
# For multi-line ajoins.
|
||||||
foreach (@cajoin) {
|
foreach (@cajoin) {
|
||||||
# Check if a key was specified.
|
# Check if a key was specified.
|
||||||
if ($_ =~ m/\s/xsm) {
|
if ($_ =~ m/\s/xsm) {
|
||||||
# There was, join with it.
|
# There was, join with it.
|
||||||
|
|||||||
+152
-152
@@ -12,18 +12,18 @@ sub new
|
|||||||
my ($file) = @_;
|
my ($file) = @_;
|
||||||
my $self = bless {}, $class;
|
my $self = bless {}, $class;
|
||||||
|
|
||||||
# Check to see if the configuration file exists.
|
# Check to see if the configuration file exists.
|
||||||
if (!-e "$Auto::Bin/../etc/$file") {
|
if (!-e "$Auto::Bin/../etc/$file") {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Open, read and close the config.
|
# Open, read and close the config.
|
||||||
open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
|
open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
|
||||||
my @cosfl = <$FCONF> or return 0;
|
my @cosfl = <$FCONF> or return 0;
|
||||||
close $FCONF or return 0;
|
close $FCONF or return 0;
|
||||||
|
|
||||||
# Save it to self variable.
|
# Save it to self variable.
|
||||||
$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";
|
$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";
|
||||||
|
|
||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
@@ -31,148 +31,148 @@ sub new
|
|||||||
# Parse the configuration file.
|
# Parse the configuration file.
|
||||||
sub parse
|
sub parse
|
||||||
{
|
{
|
||||||
# Get the path to the file.
|
# Get the path to the file.
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $file = $self->{'config'}->{'path'};
|
my $file = $self->{'config'}->{'path'};
|
||||||
my $blk = 0;
|
my $blk = 0;
|
||||||
my (%rs);
|
my (%rs);
|
||||||
|
|
||||||
# Open, read and close it.
|
# Open, read and close it.
|
||||||
open(my $FCONF, q{<}, "$file") or return 0;
|
open(my $FCONF, q{<}, "$file") or return 0;
|
||||||
my @fbuf = <$FCONF> or return 0;
|
my @fbuf = <$FCONF> or return 0;
|
||||||
close $FCONF or return 0;
|
close $FCONF or return 0;
|
||||||
|
|
||||||
# Iterate the file.
|
# Iterate the file.
|
||||||
foreach my $buff (@fbuf) {
|
foreach my $buff (@fbuf) {
|
||||||
# Main newline buffer.
|
# Main newline buffer.
|
||||||
if (defined $buff) {
|
if (defined $buff) {
|
||||||
# If the line begins with a #, it's a comment so ignore it.
|
# If the line begins with a #, it's a comment so ignore it.
|
||||||
if (substr($buff, 0, 1) eq '#') {
|
if (substr($buff, 0, 1) eq '#') {
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($buff =~ m/;/) {
|
if ($buff =~ m/;/) {
|
||||||
# Semicolon buffer.
|
# Semicolon buffer.
|
||||||
my @asbuf = split(';', $buff);
|
my @asbuf = split(';', $buff);
|
||||||
foreach my $asbuff (@asbuf) {
|
foreach my $asbuff (@asbuf) {
|
||||||
if (defined $asbuff) {
|
if (defined $asbuff) {
|
||||||
|
|
||||||
# Space buffer.
|
# Space buffer.
|
||||||
my @ebuf = split(' ', $asbuff);
|
my @ebuf = split(' ', $asbuff);
|
||||||
if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
||||||
# Garbage. Ignoring.
|
# Garbage. Ignoring.
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
my $param = $ebuf[1];
|
my $param = $ebuf[1];
|
||||||
|
|
||||||
if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
||||||
# Multi-word string.
|
# Multi-word string.
|
||||||
$param = substr($param, 1);
|
$param = substr($param, 1);
|
||||||
|
|
||||||
for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
||||||
if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
||||||
$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
||||||
last;
|
last;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$param .= " ".$ebuf[$i];
|
$param .= " ".$ebuf[$i];
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
||||||
# Single-word string.
|
# Single-word string.
|
||||||
$param = substr($param, 1, length($ebuf[1]) - 2);
|
$param = substr($param, 1, length($ebuf[1]) - 2);
|
||||||
}
|
}
|
||||||
elsif ($param =~ m/[0-9]/) {
|
elsif ($param =~ m/[0-9]/) {
|
||||||
# Numeric.
|
# Numeric.
|
||||||
$param =~ s/[^0-9.]//g;
|
$param =~ s/[^0-9.]//g;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Garbage.
|
# Garbage.
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
my @param = ($param);
|
my @param = ($param);
|
||||||
|
|
||||||
unless (!$blk) {
|
unless (!$blk) {
|
||||||
# We're inside a block.
|
# We're inside a block.
|
||||||
if ($blk =~ m/@@@/) {
|
if ($blk =~ m/@@@/) {
|
||||||
# We're inside a block with a parameter.
|
# We're inside a block with a parameter.
|
||||||
my @sblk = split('@@@', $blk);
|
my @sblk = split('@@@', $blk);
|
||||||
|
|
||||||
# Check to see if this config option already exists.
|
# Check to see if this config option already exists.
|
||||||
if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
||||||
# It does, so merely push this second one to the existing array.
|
# It does, so merely push this second one to the existing array.
|
||||||
push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# It doesn't, create it as an array.
|
# It doesn't, create it as an array.
|
||||||
@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# We're inside a block with no parameter.
|
# We're inside a block with no parameter.
|
||||||
|
|
||||||
# Check to see if this config option already exists.
|
# Check to see if this config option already exists.
|
||||||
if (defined $rs{$blk}{$ebuf[0]}) {
|
if (defined $rs{$blk}{$ebuf[0]}) {
|
||||||
# It does, so merely push this second one to the existing array.
|
# It does, so merely push this second one to the existing array.
|
||||||
push(@{ $rs{$blk}{$ebuf[0]} }, $param);
|
push(@{ $rs{$blk}{$ebuf[0]} }, $param);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# It doesn't, create it as an array.
|
# It doesn't, create it as an array.
|
||||||
@{ $rs{$blk}{$ebuf[0]} } = @param;
|
@{ $rs{$blk}{$ebuf[0]} } = @param;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# We're not inside a block.
|
# We're not inside a block.
|
||||||
|
|
||||||
# Check to see if this config option already exists.
|
# Check to see if this config option already exists.
|
||||||
if (defined $rs{$ebuf[0]}) {
|
if (defined $rs{$ebuf[0]}) {
|
||||||
# It does, so merely push this second one to the existing array.
|
# It does, so merely push this second one to the existing array.
|
||||||
push(@{ $rs{$ebuf[0]} }, $param);
|
push(@{ $rs{$ebuf[0]} }, $param);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# It doesn't, create it as an array.
|
# It doesn't, create it as an array.
|
||||||
@{ $rs{$ebuf[0]} } = @param;
|
@{ $rs{$ebuf[0]} } = @param;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# No semicolon space buffer.
|
# No semicolon space buffer.
|
||||||
my @ebuf = split(' ', $buff);
|
my @ebuf = split(' ', $buff);
|
||||||
|
|
||||||
if (!defined $ebuf[0]) {
|
if (!defined $ebuf[0]) {
|
||||||
# Garbage. Ignoring.
|
# Garbage. Ignoring.
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (defined $ebuf[1]) {
|
if (defined $ebuf[1]) {
|
||||||
if ($ebuf[1] eq '{') {
|
if ($ebuf[1] eq '{') {
|
||||||
# This is the beginning of a block with no parameter.
|
# This is the beginning of a block with no parameter.
|
||||||
$blk = $ebuf[0];
|
$blk = $ebuf[0];
|
||||||
}
|
}
|
||||||
elsif (defined $ebuf[2]) {
|
elsif (defined $ebuf[2]) {
|
||||||
if ($ebuf[2] eq '{') {
|
if ($ebuf[2] eq '{') {
|
||||||
# This is the beginning of a block with a parameter.
|
# This is the beginning of a block with a parameter.
|
||||||
my $param = $ebuf[1];
|
my $param = $ebuf[1];
|
||||||
$param =~ s/"//g;
|
$param =~ s/"//g;
|
||||||
$blk = $ebuf[0].'@@@'.$param;
|
$blk = $ebuf[0].'@@@'.$param;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if ($ebuf[0] eq '}') {
|
if ($ebuf[0] eq '}') {
|
||||||
# This is the end of a block.
|
# This is the end of a block.
|
||||||
$blk = 0;
|
$blk = 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Return the configuration data.
|
# Return the configuration data.
|
||||||
return %rs;
|
return %rs;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+250
-250
@@ -9,26 +9,26 @@ use API::IRC;
|
|||||||
|
|
||||||
# Raw parsing hash.
|
# Raw parsing hash.
|
||||||
our %RAWC = (
|
our %RAWC = (
|
||||||
'001' => \&num001,
|
'001' => \&num001,
|
||||||
'005' => \&num005,
|
'005' => \&num005,
|
||||||
'353' => \&num353,
|
'353' => \&num353,
|
||||||
'432' => \&num432,
|
'432' => \&num432,
|
||||||
'433' => \&num433,
|
'433' => \&num433,
|
||||||
'438' => \&num438,
|
'438' => \&num438,
|
||||||
'465' => \&num465,
|
'465' => \&num465,
|
||||||
'471' => \&num471,
|
'471' => \&num471,
|
||||||
'473' => \&num473,
|
'473' => \&num473,
|
||||||
'474' => \&num474,
|
'474' => \&num474,
|
||||||
'475' => \&num475,
|
'475' => \&num475,
|
||||||
'477' => \&num477,
|
'477' => \&num477,
|
||||||
'JOIN' => \&cjoin,
|
'JOIN' => \&cjoin,
|
||||||
'KICK' => \&kick,
|
'KICK' => \&kick,
|
||||||
'MODE' => \&mode,
|
'MODE' => \&mode,
|
||||||
'NICK' => \&nick,
|
'NICK' => \&nick,
|
||||||
'NOTICE' => \¬ice,
|
'NOTICE' => \¬ice,
|
||||||
'PART' => \&part,
|
'PART' => \&part,
|
||||||
'PRIVMSG' => \&privmsg,
|
'PRIVMSG' => \&privmsg,
|
||||||
'QUIT' => \&quit,
|
'QUIT' => \&quit,
|
||||||
'TOPIC' => \&topic,
|
'TOPIC' => \&topic,
|
||||||
);
|
);
|
||||||
|
|
||||||
@@ -50,33 +50,33 @@ API::Std::event_add("on_topic");
|
|||||||
# 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;
|
||||||
|
|
||||||
# Make sure there is enough data.
|
# Make sure there is enough data.
|
||||||
if (defined $ex[0] and defined $ex[1]) {
|
if (defined $ex[0] and defined $ex[1]) {
|
||||||
# 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);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# otherwise, check %RAWC for ex[1].
|
# otherwise, check %RAWC for ex[1].
|
||||||
if (defined $RAWC{$ex[1]}) {
|
if (defined $RAWC{$ex[1]}) {
|
||||||
&{ $RAWC{$ex[1]} }($svr, @ex);
|
&{ $RAWC{$ex[1]} }($svr, @ex);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
###########################
|
###########################
|
||||||
@@ -87,41 +87,41 @@ sub ircparse
|
|||||||
# 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 $botnick{$svr}{newnick}) {
|
||||||
$botnick{$svr}{nick} = $botnick{$svr}{newnick};
|
$botnick{$svr}{nick} = $botnick{$svr}{newnick};
|
||||||
delete $botnick{$svr}{newnick};
|
delete $botnick{$svr}{newnick};
|
||||||
}
|
}
|
||||||
|
|
||||||
# Trigger on_connect.
|
# Trigger on_connect.
|
||||||
API::Std::event_run("on_connect", $svr);
|
API::Std::event_run("on_connect", $svr);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: Numeric:005
|
# Parse: Numeric:005
|
||||||
# Prefixes and channel modes.
|
# Prefixes and channel modes.
|
||||||
sub num005
|
sub num005
|
||||||
{
|
{
|
||||||
my ($svr, @ex) = @_;
|
my ($svr, @ex) = @_;
|
||||||
|
|
||||||
# Find PREFIX and CHANMODES.
|
# Find PREFIX and CHANMODES.
|
||||||
foreach my $ex (@ex) {
|
foreach my $ex (@ex) {
|
||||||
if ($ex =~ m/^PREFIX/xsm) {
|
if ($ex =~ m/^PREFIX/xsm) {
|
||||||
# Found PREFIX.
|
# Found PREFIX.
|
||||||
my $rpx = substr($ex, 8);
|
my $rpx = substr($ex, 8);
|
||||||
my ($pm, $pp) = split('\)', $rpx);
|
my ($pm, $pp) = split('\)', $rpx);
|
||||||
my @apm = split(//, $pm);
|
my @apm = split(//, $pm);
|
||||||
my @app = split(//, $pp);
|
my @app = split(//, $pp);
|
||||||
foreach my $ppm (@apm) {
|
foreach my $ppm (@apm) {
|
||||||
# Store data.
|
# Store data.
|
||||||
$csprefix{$svr}{$ppm} = shift(@app);
|
$csprefix{$svr}{$ppm} = shift(@app);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($ex =~ m/^CHANMODES/xsm) {
|
elsif ($ex =~ m/^CHANMODES/xsm) {
|
||||||
# Found CHANMODES.
|
# Found CHANMODES.
|
||||||
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
|
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
|
||||||
@@ -134,186 +134,186 @@ sub num005
|
|||||||
# Modes without parameter.
|
# Modes without parameter.
|
||||||
foreach (split(//, $mts)) { $chanmodes{$svr}{$_} = 4; }
|
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] = substr($ex[5], 1);
|
||||||
# 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]});
|
delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
|
||||||
# Iterate through each user.
|
# Iterate through each user.
|
||||||
for (my $i = 5; $i < scalar(@ex); $i++) {
|
for (my $i = 5; $i < scalar(@ex); $i++) {
|
||||||
my $fi = 0;
|
my $fi = 0;
|
||||||
foreach (keys %{ $csprefix{$svr} }) {
|
foreach (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[$i], 0, 1) eq $csprefix{$svr}{$_}) {
|
||||||
# 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(substr($ex[$i], 1))}) {
|
||||||
# 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[$i], 1))} .= $_;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Or not.
|
# Or not.
|
||||||
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
|
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
|
||||||
}
|
}
|
||||||
$fi = 1;
|
$fi = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# 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[$i])}) {
|
||||||
$chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1;
|
$chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
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 001: 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});
|
delete $botnick{$svr}{newnick} if (defined $botnick{$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 $botnick{$svr}{newnick}) {
|
||||||
API::IRC::nick($svr, $botnick{$svr}{newnick}."_");
|
API::IRC::nick($svr, $botnick{$svr}{newnick}."_");
|
||||||
delete $botnick{$svr}{newnick} if (defined $botnick{$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 $botnick{$svr}{newnick}) {
|
||||||
API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub {
|
API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub {
|
||||||
API::IRC::nick($Parser::IRC::botnick{$svr}{newnick});
|
API::IRC::nick($Parser::IRC::botnick{$svr}{newnick});
|
||||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
delete $botnick{$svr}{newnick} if (defined $botnick{$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: 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 $botnick{$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));
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# It isn't. Update chanusers and trigger on_rcjoin.
|
# It isn't. Update chanusers and trigger on_rcjoin.
|
||||||
$chanusers{$svr}{lc $chan}{$src{nick}} = 1;
|
$chanusers{$svr}{lc $chan}{$src{nick}} = 1;
|
||||||
$src{svr} = $svr;
|
$src{svr} = $svr;
|
||||||
API::Std::event_run("on_rcjoin", (\%src, $chan));
|
API::Std::event_run("on_rcjoin", (\%src, $chan));
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: KICK
|
# Parse: KICK
|
||||||
@@ -454,35 +454,35 @@ sub mode
|
|||||||
# Parse: NICK
|
# Parse: NICK
|
||||||
sub nick
|
sub nick
|
||||||
{
|
{
|
||||||
my ($svr, ($uex, undef, $nex)) = @_;
|
my ($svr, ($uex, undef, $nex)) = @_;
|
||||||
$nex = substr($nex, 1);
|
$nex = substr($nex, 1);
|
||||||
|
|
||||||
my %src = API::IRC::usrc(substr($uex, 1));
|
my %src = API::IRC::usrc(substr($uex, 1));
|
||||||
|
|
||||||
# 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 $botnick{$svr}{nick}) {
|
||||||
# It is. Update bot nick hash.
|
# It is. Update bot nick hash.
|
||||||
$botnick{$svr}{nick} = $nex;
|
$botnick{$svr}{nick} = $nex;
|
||||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# It isn't. Update chanusers and trigger on_nick.
|
# It isn't. Update chanusers and trigger on_nick.
|
||||||
foreach my $chk (keys %{ $chanusers{$svr} }) {
|
foreach my $chk (keys %{ $chanusers{$svr} }) {
|
||||||
if (defined $chanusers{$svr}{$chk}{$src{nick}}) {
|
if (defined $chanusers{$svr}{$chk}{$src{nick}}) {
|
||||||
$chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{nick}};
|
$chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{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", ($svr, \%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.
|
||||||
if ($ex[0] !~ m/!/xsm) { return; }
|
if ($ex[0] !~ m/!/xsm) { return; }
|
||||||
@@ -493,11 +493,11 @@ sub notice
|
|||||||
shift @ex; shift @ex; shift @ex;
|
shift @ex; shift @ex; shift @ex;
|
||||||
$ex[0] = substr $ex[0], 1;
|
$ex[0] = substr $ex[0], 1;
|
||||||
$src{svr} = $svr;
|
$src{svr} = $svr;
|
||||||
|
|
||||||
# Send it off.
|
# Send it off.
|
||||||
API::Std::event_run("on_notice", (\%src, $target, @ex));
|
API::Std::event_run("on_notice", (\%src, $target, @ex));
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse: PART
|
# Parse: PART
|
||||||
@@ -529,33 +529,33 @@ sub part
|
|||||||
# 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));
|
||||||
|
|
||||||
# Ensure this is coming from a user rather than a server.
|
# Ensure this is coming from a user rather than a server.
|
||||||
if ($ex[0] !~ m/!/xsm) { return; }
|
if ($ex[0] !~ m/!/xsm) { return; }
|
||||||
|
|
||||||
my @argv;
|
my @argv;
|
||||||
for (my $i = 4; $i < scalar(@ex); $i++) {
|
for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||||
push(@argv, $ex[$i]);
|
push(@argv, $ex[$i]);
|
||||||
}
|
}
|
||||||
$data{svr} = $svr;
|
$data{svr} = $svr;
|
||||||
|
|
||||||
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($botnick{$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.
|
||||||
if (length($ex[3]) > 1) {
|
if (length($ex[3]) > 1) {
|
||||||
$cmd = uc(substr($ex[3], 1));
|
$cmd = uc(substr($ex[3], 1));
|
||||||
if (defined $API::Std::CMDS{$cmd}) {
|
if (defined $API::Std::CMDS{$cmd}) {
|
||||||
# If this is indeed a command, continue.
|
# If this is indeed a command, continue.
|
||||||
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||||
# Ensure the level is private or all.
|
# Ensure the level is private or all.
|
||||||
if (API::Std::ratelimit_check(%data)) {
|
if (API::Std::ratelimit_check(%data)) {
|
||||||
# Continue if the user has not passed the ratelimit amount.
|
# Continue if the user has not passed the ratelimit amount.
|
||||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||||
# If this command requires a privilege...
|
# If this command requires a privilege...
|
||||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||||
# Make sure they have it.
|
# Make sure they have it.
|
||||||
@@ -575,26 +575,26 @@ sub privmsg
|
|||||||
# Send them a notice about their bad deed.
|
# Send them a notice about their bad deed.
|
||||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Trigger event on_uprivmsg.
|
# Trigger event on_uprivmsg.
|
||||||
shift @ex; shift @ex; shift @ex;
|
shift @ex; shift @ex; shift @ex;
|
||||||
$ex[0] = substr $ex[0], 1;
|
$ex[0] = substr $ex[0], 1;
|
||||||
API::Std::event_run("on_uprivmsg", (\%data, @ex));
|
API::Std::event_run("on_uprivmsg", (\%data, @ex));
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# It is coming to us in a channel message.
|
# It is coming to us in a channel message.
|
||||||
$data{chan} = $ex[2];
|
$data{chan} = $ex[2];
|
||||||
# Ensure it's a valid length before continuing.
|
# Ensure it's a valid length before continuing.
|
||||||
if (length($ex[3]) > 1) {
|
if (length($ex[3]) > 1) {
|
||||||
$cprefix = (conf_get("fantasy_pf"))[0][0];
|
$cprefix = (conf_get("fantasy_pf"))[0][0];
|
||||||
$rprefix = substr($ex[3], 1, 1);
|
$rprefix = substr($ex[3], 1, 1);
|
||||||
$cmd = uc(substr($ex[3], 2));
|
$cmd = uc(substr($ex[3], 2));
|
||||||
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
|
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
|
||||||
# If this is indeed a command, continue.
|
# If this is indeed a command, continue.
|
||||||
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||||
# Ensure the level is public or all.
|
# Ensure the level is public or all.
|
||||||
if (API::Std::ratelimit_check(%data)) {
|
if (API::Std::ratelimit_check(%data)) {
|
||||||
# Continue if the user has not passed the ratelimit amount.
|
# Continue if the user has not passed the ratelimit amount.
|
||||||
@@ -641,24 +641,24 @@ sub privmsg
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Trigger event on_cprivmsg.
|
# Trigger event on_cprivmsg.
|
||||||
my $target = $ex[2]; delete $data{chan};
|
my $target = $ex[2]; delete $data{chan};
|
||||||
shift @ex; shift @ex; shift @ex;
|
shift @ex; shift @ex; shift @ex;
|
||||||
$ex[0] = substr $ex[0], 1;
|
$ex[0] = substr $ex[0], 1;
|
||||||
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
|
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# 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));
|
||||||
|
|
||||||
# Set $msg to the quit message.
|
# Set $msg to the quit message.
|
||||||
my $msg = 0;
|
my $msg = 0;
|
||||||
@@ -680,23 +680,23 @@ sub quit
|
|||||||
# 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));
|
||||||
|
|
||||||
# Ignore it if it's coming from us.
|
# Ignore it if it's coming from us.
|
||||||
if (lc($src{nick}) ne lc($botnick{$svr}{nick})) {
|
if (lc($src{nick}) ne lc($botnick{$svr}{nick})) {
|
||||||
$src{chan} = $ex[2];
|
$src{chan} = $ex[2];
|
||||||
my (@argv);
|
my (@argv);
|
||||||
$argv[0] = substr($ex[3], 1);
|
$argv[0] = substr($ex[3], 1);
|
||||||
if (defined $ex[4]) {
|
if (defined $ex[4]) {
|
||||||
for (my $i = 4; $i < scalar(@ex); $i++) {
|
for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||||
push(@argv, $ex[$i]);
|
push(@argv, $ex[$i]);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
API::Std::event_run("on_topic", ($svr, \%src, @argv));
|
API::Std::event_run("on_topic", ($svr, \%src, @argv));
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+50
-50
@@ -10,56 +10,56 @@ use API::Log qw(dbug alog);
|
|||||||
# Parser.
|
# Parser.
|
||||||
sub parse
|
sub parse
|
||||||
{
|
{
|
||||||
my ($lang) = @_;
|
my ($lang) = @_;
|
||||||
|
|
||||||
# Check that the language file exists.
|
# Check that the language file exists.
|
||||||
unless (-e "$Auto::Bin/../lang/$lang.alf") {
|
unless (-e "$Auto::Bin/../lang/$lang.alf") {
|
||||||
# Otherwise, use English.
|
# Otherwise, use English.
|
||||||
dbug "Language '$lang' not found. Using English.";
|
dbug "Language '$lang' not found. Using English.";
|
||||||
alog "Language '$lang' not found. Using English.";
|
alog "Language '$lang' not found. Using English.";
|
||||||
$lang = "en";
|
$lang = "en";
|
||||||
}
|
}
|
||||||
|
|
||||||
# Open, read and close the file.
|
# Open, read and close the file.
|
||||||
open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0;
|
open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0;
|
||||||
my @fbuf = <$FALF>;
|
my @fbuf = <$FALF>;
|
||||||
close $FALF;
|
close $FALF;
|
||||||
|
|
||||||
# Iterate the file buffer.
|
# Iterate the file buffer.
|
||||||
foreach my $buff (@fbuf) {
|
foreach my $buff (@fbuf) {
|
||||||
if (defined $buff) {
|
if (defined $buff) {
|
||||||
# Space buffer.
|
# Space buffer.
|
||||||
my @sbuf = split(' ', $buff);
|
my @sbuf = split(' ', $buff);
|
||||||
|
|
||||||
# Check for all required values.
|
# Check for all required values.
|
||||||
if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
||||||
# Missing a value.
|
# Missing a value.
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Make sure the first value is "msge".
|
# Make sure the first value is "msge".
|
||||||
if ($sbuf[0] ne "msge") {
|
if ($sbuf[0] ne "msge") {
|
||||||
# It isn't.
|
# It isn't.
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $id = $sbuf[1];
|
my $id = $sbuf[1];
|
||||||
my $val = $sbuf[2];
|
my $val = $sbuf[2];
|
||||||
|
|
||||||
# If the translation is multi-word, continue to parse.
|
# If the translation is multi-word, continue to parse.
|
||||||
if (defined $sbuf[3]) {
|
if (defined $sbuf[3]) {
|
||||||
for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
||||||
$val .= " ".$sbuf[$i];
|
$val .= " ".$sbuf[$i];
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Save to memory.
|
# Save to memory.
|
||||||
$id =~ s/"//g;
|
$id =~ s/"//g;
|
||||||
$val =~ s/"//g;
|
$val =~ s/"//g;
|
||||||
$API::Std::LANGE{$id} = $val;
|
$API::Std::LANGE{$id} = $val;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+8
-8
@@ -12,12 +12,12 @@ use API::IRC qw(privmsg notice kick ban);
|
|||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Check for required configuration values.
|
# Check for required configuration values.
|
||||||
if (!conf_get('badwords')) {
|
if (!conf_get('badwords')) {
|
||||||
err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
|
err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
# Create the act_on_badword hook.
|
# Create the act_on_badword hook.
|
||||||
hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return;
|
hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
@@ -27,16 +27,16 @@ sub _init
|
|||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the act_on_badword hook.
|
# Delete the act_on_badword hook.
|
||||||
hook_del('act_on_badword') or return 0;
|
hook_del('act_on_badword') or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Callback for act_on_badword hook.
|
# Callback for act_on_badword hook.
|
||||||
sub actonbadword
|
sub actonbadword
|
||||||
{
|
{
|
||||||
my (($src, $chan, @msg)) = @_;
|
my (($src, $chan, @msg)) = @_;
|
||||||
|
|
||||||
my $msg = join ' ', @msg;
|
my $msg = join ' ', @msg;
|
||||||
|
|
||||||
|
|||||||
+27
-27
@@ -13,13 +13,13 @@ use URI::Escape;
|
|||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Check for required configuration values.
|
# Check for required configuration values.
|
||||||
if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) {
|
if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) {
|
||||||
err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0);
|
err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
# Create the SHORTEN and REVERSE commands.
|
# Create the SHORTEN and REVERSE commands.
|
||||||
cmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0;
|
cmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0;
|
||||||
cmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0;
|
cmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
@@ -29,11 +29,11 @@ sub _init
|
|||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the SHORTEN and REVERSE commands.
|
# Delete the SHORTEN and REVERSE commands.
|
||||||
cmd_del("SHORTEN") or return 0;
|
cmd_del("SHORTEN") or return 0;
|
||||||
cmd_del("REVERSE") or return 0;
|
cmd_del("REVERSE") or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Help hashes.
|
# Help hashes.
|
||||||
@@ -47,37 +47,37 @@ our %HELP_REVERSE = (
|
|||||||
# Callback for SHORTEN command.
|
# Callback for SHORTEN command.
|
||||||
sub shorten
|
sub shorten
|
||||||
{
|
{
|
||||||
my ($src, @args) = @_;
|
my ($src, @args) = @_;
|
||||||
|
|
||||||
# Create an instance of LWP::UserAgent.
|
# Create an instance of LWP::UserAgent.
|
||||||
my $ua = LWP::UserAgent->new();
|
my $ua = LWP::UserAgent->new();
|
||||||
$ua->agent('Auto IRC Bot');
|
$ua->agent('Auto IRC Bot');
|
||||||
$ua->timeout(2);
|
$ua->timeout(2);
|
||||||
|
|
||||||
# Put together the call to the Bit.ly API.
|
# Put together the call to the Bit.ly API.
|
||||||
if (!defined $args[0]) {
|
if (!defined $args[0]) {
|
||||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
|
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
|
||||||
$surl = uri_escape($surl);
|
$surl = uri_escape($surl);
|
||||||
my $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt";
|
my $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt";
|
||||||
# Get the response via HTTP.
|
# Get the response via HTTP.
|
||||||
my $response = $ua->get($url);
|
my $response = $ua->get($url);
|
||||||
|
|
||||||
if ($response->is_success) {
|
if ($response->is_success) {
|
||||||
# If successful, decode the content.
|
# If successful, decode the content.
|
||||||
my $d = $response->decoded_content;
|
my $d = $response->decoded_content;
|
||||||
chomp $d;
|
chomp $d;
|
||||||
# And send to channel.
|
# And send to channel.
|
||||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, send an error message.
|
# Otherwise, send an error message.
|
||||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while shortening your URL.");
|
privmsg($src->{svr}, $src->{chan}, "An error occurred while shortening your URL.");
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Callback for REVERSE command.
|
# Callback for REVERSE command.
|
||||||
@@ -104,16 +104,16 @@ sub reverse
|
|||||||
if ($response->is_success) {
|
if ($response->is_success) {
|
||||||
# If successful, decode the content.
|
# If successful, decode the content.
|
||||||
my $d = $response->decoded_content;
|
my $d = $response->decoded_content;
|
||||||
chomp $d;
|
chomp $d;
|
||||||
# And send it to channel.
|
# And send it to channel.
|
||||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, send an error message.
|
# Otherwise, send an error message.
|
||||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL.");
|
privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL.");
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+36
-36
@@ -13,68 +13,68 @@ use JSON -support_by_pp;
|
|||||||
# Initialization subroutine.
|
# Initialization subroutine.
|
||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Create the CALC command.
|
# Create the CALC command.
|
||||||
cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0;
|
cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Void subroutine.
|
# Void subroutine.
|
||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the CALC command.
|
# Delete the CALC command.
|
||||||
cmd_del("CALC") or return 0;
|
cmd_del("CALC") or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Help hash.
|
# Help hash.
|
||||||
our %FHELP_CALC = (
|
our %FHELP_CALC = (
|
||||||
'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC <expression>",
|
'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC <expression>",
|
||||||
);
|
);
|
||||||
|
|
||||||
# Callback for CALC command.
|
# Callback for CALC command.
|
||||||
sub calc
|
sub calc
|
||||||
{
|
{
|
||||||
my ($src, @args) = @_;
|
my ($src, @args) = @_;
|
||||||
|
|
||||||
# Create an instance of LWP::UserAgent.
|
# Create an instance of LWP::UserAgent.
|
||||||
my $ua = LWP::UserAgent->new();
|
my $ua = LWP::UserAgent->new();
|
||||||
$ua->agent('Auto IRC Bot');
|
$ua->agent('Auto IRC Bot');
|
||||||
$ua->timeout(2);
|
$ua->timeout(2);
|
||||||
# Create an instance of JSON.
|
# Create an instance of JSON.
|
||||||
my $json = JSON->new();
|
my $json = JSON->new();
|
||||||
# Put together the call to the Google Calculator API.
|
# Put together the call to the Google Calculator API.
|
||||||
if (!defined $args[0]) {
|
if (!defined $args[0]) {
|
||||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
my $expr = join(' ', @args);
|
my $expr = join(' ', @args);
|
||||||
my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr);
|
my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr);
|
||||||
# Get the response via HTTP.
|
# Get the response via HTTP.
|
||||||
my $response = $ua->get($url);
|
my $response = $ua->get($url);
|
||||||
|
|
||||||
if ($response->is_success) {
|
if ($response->is_success) {
|
||||||
# If successful, decode the content.
|
# If successful, decode the content.
|
||||||
my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
|
my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
|
||||||
|
|
||||||
if ($d->{error} eq "" or $d->{error} == 0) {
|
if ($d->{error} eq "" or $d->{error} == 0) {
|
||||||
# And send to channel
|
# And send to channel
|
||||||
privmsg($src->{svr}, $src->{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
|
privmsg($src->{svr}, $src->{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, send an error message.
|
# Otherwise, send an error message.
|
||||||
privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
|
privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, send an error message.
|
# Otherwise, send an error message.
|
||||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator.");
|
privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator.");
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
|
|||||||
@@ -13,8 +13,8 @@ our $ANSWER = 0;
|
|||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Create the 8BALL and RIGBALL commands.
|
# Create the 8BALL and RIGBALL commands.
|
||||||
cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0;
|
cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0;
|
||||||
cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0;
|
cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
@@ -24,11 +24,11 @@ sub _init
|
|||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the 8BALL and RIGBALL commands.
|
# Delete the 8BALL and RIGBALL commands.
|
||||||
cmd_del('8BALL') or return 0;
|
cmd_del('8BALL') or return 0;
|
||||||
cmd_del('RIGBALL') or return 0;
|
cmd_del('RIGBALL') or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Help hashes.
|
# Help hashes.
|
||||||
@@ -42,7 +42,7 @@ our %HELP_RIGBALL = (
|
|||||||
# Callback for 8BALL command.
|
# Callback for 8BALL command.
|
||||||
sub c_8ball
|
sub c_8ball
|
||||||
{
|
{
|
||||||
my ($src, @argv) = @_;
|
my ($src, @argv) = @_;
|
||||||
|
|
||||||
if (!defined $argv[0]) {
|
if (!defined $argv[0]) {
|
||||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||||
@@ -77,7 +77,7 @@ sub c_8ball
|
|||||||
|
|
||||||
privmsg($src->{svr}, $src->{chan}, "\002Answer:\002 ".$a);
|
privmsg($src->{svr}, $src->{chan}, "\002Answer:\002 ".$a);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Callback for RIGBALL command.
|
# Callback for RIGBALL command.
|
||||||
@@ -94,7 +94,7 @@ sub rigball
|
|||||||
$ANSWER = join(" ", @argv);
|
$ANSWER = join(" ", @argv);
|
||||||
privmsg($src->{svr}, $src->{nick}, "Answer set to: ".$ANSWER);
|
privmsg($src->{svr}, $src->{nick}, "Answer set to: ".$ANSWER);
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+12
-12
@@ -12,7 +12,7 @@ use LWP::UserAgent;
|
|||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Create the FML command.
|
# Create the FML command.
|
||||||
cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0;
|
cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
@@ -22,10 +22,10 @@ sub _init
|
|||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the FML command.
|
# Delete the FML command.
|
||||||
cmd_del('FML') or return 0;
|
cmd_del('FML') or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Help hash.
|
# Help hash.
|
||||||
@@ -36,34 +36,34 @@ our %HELP_FML = (
|
|||||||
# Callback for FML command.
|
# Callback for FML command.
|
||||||
sub fml
|
sub fml
|
||||||
{
|
{
|
||||||
my ($src, undef) = @_;
|
my ($src, undef) = @_;
|
||||||
|
|
||||||
# Create an instance of LWP::UserAgent.
|
# Create an instance of LWP::UserAgent.
|
||||||
my $ua = LWP::UserAgent->new();
|
my $ua = LWP::UserAgent->new();
|
||||||
$ua->agent('Auto IRC Bot');
|
$ua->agent('Auto IRC Bot');
|
||||||
$ua->timeout(2);
|
$ua->timeout(2);
|
||||||
|
|
||||||
# Get the random FML via HTTP.
|
# Get the random FML via HTTP.
|
||||||
my $rp = $ua->get('http://rscript.org/lookup.php?type=fml');
|
my $rp = $ua->get('http://rscript.org/lookup.php?type=fml');
|
||||||
|
|
||||||
if ($rp->is_success) {
|
if ($rp->is_success) {
|
||||||
# If successful, decode the content.
|
# If successful, decode the content.
|
||||||
my $d = $rp->decoded_content;
|
my $d = $rp->decoded_content;
|
||||||
$d =~ s/(\n|\r)//g;
|
$d =~ s/(\n|\r)//g;
|
||||||
|
|
||||||
# Get the FML.
|
# Get the FML.
|
||||||
my (undef, $dfa) = split('Text: ', $d);
|
my (undef, $dfa) = split('Text: ', $d);
|
||||||
my ($fml, undef) = split('Agree:', $dfa);
|
my ($fml, undef) = split('Agree:', $dfa);
|
||||||
|
|
||||||
# And send to channel.
|
# And send to channel.
|
||||||
privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
|
privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, send an error message.
|
# Otherwise, send an error message.
|
||||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving the FML.");
|
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving the FML.");
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
|
|||||||
+12
-12
@@ -10,28 +10,28 @@ use API::IRC qw(privmsg);
|
|||||||
# Initialization subroutine.
|
# Initialization subroutine.
|
||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Add a hook for when we join a channel.
|
# Add a hook for when we join a channel.
|
||||||
hook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0;
|
hook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Void subroutine.
|
# Void subroutine.
|
||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the hook.
|
# Delete the hook.
|
||||||
hook_del("on_ucjoin", "HelloChan") or return 0;
|
hook_del("on_ucjoin", "HelloChan") or return 0;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Main subroutine.
|
# Main subroutine.
|
||||||
sub hello
|
sub hello
|
||||||
{
|
{
|
||||||
my (($svr, $chan)) = @_;
|
my (($svr, $chan)) = @_;
|
||||||
|
|
||||||
# Send a PRIVMSG.
|
# Send a PRIVMSG.
|
||||||
privmsg($svr, $chan, "Hello channel! I am a bot!");
|
privmsg($svr, $chan, "Hello channel! I am a bot!");
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
+35
-35
@@ -11,61 +11,61 @@ use LWP::UserAgent;
|
|||||||
# Initialization subroutine.
|
# Initialization subroutine.
|
||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Create the ISITUP command.
|
# Create the ISITUP command.
|
||||||
cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0;
|
cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Void subroutine.
|
# Void subroutine.
|
||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the ISITUP command.
|
# Delete the ISITUP command.
|
||||||
cmd_del('ISITUP') or return 0;
|
cmd_del('ISITUP') or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Help hashes.
|
# Help hashes.
|
||||||
our %HELP_ISITUP = (
|
our %HELP_ISITUP = (
|
||||||
'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>",
|
'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>",
|
||||||
);
|
);
|
||||||
|
|
||||||
# Callback for ISITUP command.
|
# Callback for ISITUP command.
|
||||||
sub check
|
sub check
|
||||||
{
|
{
|
||||||
my ($src, @argv) = @_;
|
my ($src, @argv) = @_;
|
||||||
|
|
||||||
# Create an instance of LWP::UserAgent.
|
# Create an instance of LWP::UserAgent.
|
||||||
my $ua = LWP::UserAgent->new();
|
my $ua = LWP::UserAgent->new();
|
||||||
$ua->agent('Auto IRC Bot');
|
$ua->agent('Auto IRC Bot');
|
||||||
$ua->timeout(2);
|
$ua->timeout(2);
|
||||||
# Do we have enough parameters?
|
# Do we have enough parameters?
|
||||||
if (!defined $argv[0]) {
|
if (!defined $argv[0]) {
|
||||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
my $curl = $argv[0];
|
my $curl = $argv[0];
|
||||||
# Does the URL start with http(s)?
|
# Does the URL start with http(s)?
|
||||||
if ($curl !~ m/^http/) {
|
if ($curl !~ m/^http/) {
|
||||||
$curl = 'http://'.$curl;
|
$curl = 'http://'.$curl;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Get the response via HTTP.
|
# Get the response via HTTP.
|
||||||
my $response = $ua->get($curl);
|
my $response = $ua->get($curl);
|
||||||
|
|
||||||
if ($response->is_success) {
|
if ($response->is_success) {
|
||||||
# If successful, it's up.
|
# If successful, it's up.
|
||||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
|
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, it's down.
|
# Otherwise, it's down.
|
||||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
|
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
|
|||||||
+9
-9
@@ -13,9 +13,9 @@ use API::IRC qw(privmsg);
|
|||||||
# Initialization subroutine.
|
# Initialization subroutine.
|
||||||
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/;
|
err(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/;
|
||||||
# Add a hook for before we connect.
|
# Add a hook for before we connect.
|
||||||
hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); }
|
hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); }
|
||||||
) or return 0;
|
) or return 0;
|
||||||
# Hook for parsing CAP.
|
# Hook for parsing CAP.
|
||||||
@@ -26,19 +26,19 @@ sub _init
|
|||||||
rchook_add('904', \&M::SASLAuth::handle_904) or return 0;
|
rchook_add('904', \&M::SASLAuth::handle_904) or return 0;
|
||||||
# Hook for parsing 906.
|
# Hook for parsing 906.
|
||||||
rchook_add('906', \&M::SASLAuth::handle_906) or return 0;
|
rchook_add('906', \&M::SASLAuth::handle_906) or return 0;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Void subroutine.
|
# Void subroutine.
|
||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the hooks.
|
# Delete the hooks.
|
||||||
hook_del("on_preconnect", "CAP") or return 0;
|
hook_del("on_preconnect", "CAP") or return 0;
|
||||||
rchook_del('CAP');
|
rchook_del('CAP');
|
||||||
rchook_del('903');
|
rchook_del('903');
|
||||||
rchook_del('904');
|
rchook_del('904');
|
||||||
rchook_del('906');
|
rchook_del('906');
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub handle_cap {
|
sub handle_cap {
|
||||||
@@ -123,8 +123,8 @@ sub handle_904
|
|||||||
# SASL authentication aborted.
|
# SASL authentication aborted.
|
||||||
sub handle_906
|
sub handle_906
|
||||||
{
|
{
|
||||||
my ($svr, undef) = @_;
|
my ($svr, undef) = @_;
|
||||||
Auto::socksnd($svr, 'CAP END');
|
Auto::socksnd($svr, 'CAP END');
|
||||||
timer_del('auth_timeout');
|
timer_del('auth_timeout');
|
||||||
awarn(2, "SASL authentication aborted!");
|
awarn(2, "SASL authentication aborted!");
|
||||||
}
|
}
|
||||||
|
|||||||
+44
-44
@@ -12,69 +12,69 @@ use XML::Simple;
|
|||||||
# Initialization subroutine.
|
# Initialization subroutine.
|
||||||
sub _init
|
sub _init
|
||||||
{
|
{
|
||||||
# Create the Weather command.
|
# Create the Weather command.
|
||||||
cmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0;
|
cmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Void subroutine.
|
# Void subroutine.
|
||||||
sub _void
|
sub _void
|
||||||
{
|
{
|
||||||
# Delete the Weather command.
|
# Delete the Weather command.
|
||||||
cmd_del("WEATHER") or return 0;
|
cmd_del("WEATHER") or return 0;
|
||||||
|
|
||||||
# Success.
|
# Success.
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Help hashes.
|
# Help hashes.
|
||||||
our %HELP_WEATHER = (
|
our %HELP_WEATHER = (
|
||||||
'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>",
|
'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>",
|
||||||
);
|
);
|
||||||
|
|
||||||
# Callback for Weather command.
|
# Callback for Weather command.
|
||||||
sub weather
|
sub weather
|
||||||
{
|
{
|
||||||
my ($src, @args) = @_;
|
my ($src, @args) = @_;
|
||||||
|
|
||||||
# Create an instance of LWP::UserAgent.
|
# Create an instance of LWP::UserAgent.
|
||||||
my $ua = LWP::UserAgent->new();
|
my $ua = LWP::UserAgent->new();
|
||||||
$ua->agent('Auto IRC Bot');
|
$ua->agent('Auto IRC Bot');
|
||||||
$ua->timeout(2);
|
$ua->timeout(2);
|
||||||
# Put together the call to the Wunderground API.
|
# Put together the call to the Wunderground API.
|
||||||
if (!defined $args[0]) {
|
if (!defined $args[0]) {
|
||||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
my $loc = join(' ', @args);
|
my $loc = join(' ', @args);
|
||||||
$loc =~ s/ /%20/g;
|
$loc =~ s/ /%20/g;
|
||||||
my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc;
|
my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc;
|
||||||
# Get the response via HTTP.
|
# Get the response via HTTP.
|
||||||
my $response = $ua->get($url);
|
my $response = $ua->get($url);
|
||||||
|
|
||||||
if ($response->is_success) {
|
if ($response->is_success) {
|
||||||
# If successful, decode the content.
|
# If successful, decode the content.
|
||||||
my $d = XMLin($response->decoded_content);
|
my $d = XMLin($response->decoded_content);
|
||||||
# And send to channel
|
# And send to channel
|
||||||
if (!ref($d->{observation_location}->{country})) {
|
if (!ref($d->{observation_location}->{country})) {
|
||||||
my $windc = $d->{wind_string};
|
my $windc = $d->{wind_string};
|
||||||
if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); }
|
if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); }
|
||||||
privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
|
privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
|
||||||
privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
|
privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, send an error message.
|
# Otherwise, send an error message.
|
||||||
privmsg($src->{svr}, $src->{chan}, "Location not found.");
|
privmsg($src->{svr}, $src->{chan}, "Location not found.");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# Otherwise, send an error message.
|
# Otherwise, send an error message.
|
||||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather.");
|
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather.");
|
||||||
}
|
}
|
||||||
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Start initialization.
|
# Start initialization.
|
||||||
|
|||||||
Reference in new issue
Block a user