GitHub
/
pbot
mirror of https://github.com/pragma-/pbot.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity

Tidy things up

This commit is contained in:
Pragmatic Software 2020-02-15 14:38:32 -08:00
parent c14402dd04
commit 5c4e10a35c
119 changed files with 21787 additions and 23105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
PBot/AntiFlood.pm
View File

@ -121,9 +121,7 @@ sub ban_exempt {
return "Usage: ban-exempt remove <channel> <mask>" if not defined $channel or not defined $mask;
return $self->{'ban-exemptions'}->remove($channel, $mask);
}
default {
return "Unknown command '$command'; commands are: list, add, remove";
}
default { return "Unknown command '$command'; commands are: list, add, remove"; }
}
}
@ -138,6 +136,7 @@ sub update_join_watch {
$channel_data->{join_watch}++;
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data);
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) {
# PART or QUIT
# check QUIT message for netsplits, and decrement joinwatch to allow a free rejoin
if ($text =~ /^QUIT .*\.net .*\.split/) {
@ -146,15 +145,19 @@ sub update_join_watch {
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data);
}
}
# check QUIT message for Ping timeout or Excess Flood
elsif ($text =~ /^QUIT Excess Flood/ or $text =~ /^QUIT Max SendQ exceeded/ or $text =~ /^QUIT Ping timeout/) {
# treat these as an extra join so they're snagged more quickly since these usually will keep flooding
$channel_data->{join_watch}++;
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data);
} else {
# some other type of QUIT or PART
}
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) {
# reset joinwatch if they send a message
if ($channel_data->{join_watch} > 0) {
$channel_data->{join_watch} = 0;
@ -219,12 +222,11 @@ sub check_flood {
}
# don't do flood processing for unidentified or banned users in +z channels
if (defined $stuff and $stuff->{'chan-z'} and ($stuff->{'unidentified'} or $stuff->{'banned'})) {
return;
}
if (defined $stuff and $stuff->{'chan-z'} and ($stuff->{'unidentified'} or $stuff->{'banned'})) { return; }
my $ancestor = $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($account);
$self->{pbot}->{logger}->log("Processing anti-flood account $account " . ($ancestor != $account ? "[ancestor $ancestor] " : '') . "for mask $mask\n") if $self->{pbot}->{registry}->get_value('antiflood', 'debug_account');
$self->{pbot}->{logger}->log("Processing anti-flood account $account " . ($ancestor != $account ? "[ancestor $ancestor] " : '') . "for mask $mask\n")
if $self->{pbot}->{registry}->get_value('antiflood', 'debug_account');
if ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) {
$self->{nickflood}->{$ancestor}->{changes}++;
@ -253,20 +255,21 @@ sub check_flood {
}
my $channels;
if ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) {
$channels = $self->{pbot}->{nicklist}->get_channels($oldnick);
} else {
if ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { $channels = $self->{pbot}->{nicklist}->get_channels($oldnick); }
else {
$self->update_join_watch($account, $channel, $text, $mode);
push @$channels, $channel;
}
foreach my $chan (@$channels) {
$chan = lc $chan;
# do not do flood processing if channel is not in bot's channel list or bot is not set as chanop for the channel
next if $chan =~ /^#/ and not $self->{pbot}->{chanops}->can_gain_ops($chan);
my $u = $self->{pbot}->{users}->loggedin($chan, "$nick!$user\@$host");
if ($chan =~ /^#/ and $mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) {
# remove validation on PART or KICK so we check for ban-evasion when user returns at a later time
my $chan_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $chan, 'validated');
if ($chan_data->{validated} & $self->{NICKSERV_VALIDATED}) {
@ -276,9 +279,7 @@ sub check_flood {
next;
}
if ($self->{pbot}->{capabilities}->userhas($u, 'is-whitelisted')) {
next;
}
if ($self->{pbot}->{capabilities}->userhas($u, 'is-whitelisted')) { next; }
if ($max_messages > $self->{pbot}->{registry}->get_value('messagehistory', 'max_messages')) {
$self->{pbot}->{logger}->log("Warning: max_messages greater than max_messages limit; truncating.\n");
@ -291,6 +292,7 @@ sub check_flood {
if ($validated & $self->{NEEDS_CHECKBAN} or not $validated & $self->{NICKSERV_VALIDATED}) {
if ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) {
# don't check for evasion on PART/KICK
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) {
if (not exists $self->{whois_pending}->{$nick}) {
@ -300,6 +302,7 @@ sub check_flood {
}
} else {
if ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN} && exists $self->{pbot}->{irc_capabilities}->{'extended-join'}) {
# don't WHOIS joins if extended-join capability is active
} elsif (not exists $self->{pbot}->{irc_capabilities}->{'account-notify'}) {
if (not exists $self->{whois_pending}->{$nick}) {
@ -334,24 +337,25 @@ sub check_flood {
}
# check for chat/join/private message flooding
if ($max_messages > 0 and $self->{pbot}->{messagehistory}->{database}->get_max_messages($account, $chan, $mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE} ? $nick : undef) >= $max_messages) {
if ( $max_messages > 0
and $self->{pbot}->{messagehistory}->{database}->get_max_messages($account, $chan, $mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE} ? $nick : undef) >=
$max_messages)
{
my $msg;
if ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) {
$msg = $self->{pbot}->{messagehistory}->{database}->recall_message_by_count($account, $chan, $max_messages - 1)
}
elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN}) {
$msg = $self->{pbot}->{messagehistory}->{database}->recall_message_by_count($account, $chan, $max_messages - 1);
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN}) {
my $joins = $self->{pbot}->{messagehistory}->{database}->get_recent_messages($account, $chan, $max_messages, $self->{pbot}->{messagehistory}->{MSG_JOIN});
$msg = $joins->[0];
}
elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) {
my $nickchanges = $self->{pbot}->{messagehistory}->{database}->get_recent_messages($ancestor, $chan, $max_messages, $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}, $nick);
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) {
my $nickchanges =
$self->{pbot}->{messagehistory}->{database}->get_recent_messages($ancestor, $chan, $max_messages, $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}, $nick);
$msg = $nickchanges->[0];
}
elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) {
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) {
# no flood checks to be done for departure events
next;
}
else {
} else {
$self->{pbot}->{logger}->log("Unknown flood mode [$mode] ... aborting flood enforcement.\n");
return;
}
@ -366,6 +370,7 @@ sub check_flood {
if ($last->{timestamp} - $msg->{timestamp} <= $max_time) {
if ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN}) {
my $chan_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $chan, 'offenses', 'last_offense', 'join_watch');
#$self->{pbot}->{logger}->log("$account offenses $chan_data->{offenses}, join watch $chan_data->{join_watch}, max messages $max_messages\n");
if ($chan_data->{join_watch} >= $max_messages) {
$chan_data->{offenses}++;
@ -377,9 +382,13 @@ sub check_flood {
my $banmask = $self->address_to_mask($host);
if ($self->{pbot}->{channels}->is_active_op("${channel}-floodbans")) {
$self->{pbot}->{chanops}->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'join flooding', "*!$user\@$banmask\$##stop_join_flood", $chan . '-floodbans', $timeout);
$self->{pbot}->{chanops}
->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'join flooding', "*!$user\@$banmask\$##stop_join_flood", $chan . '-floodbans', $timeout);
$self->{pbot}->{logger}->log("$nick!$user\@$banmask banned for $duration due to join flooding (offense #" . $chan_data->{offenses} . ").\n");
$self->{pbot}->{conn}->privmsg($nick, "You have been banned from $chan due to join flooding. If your connection issues have been fixed, or this was an accident, you may request an unban at any time by responding to this message with `unbanme`, otherwise you will be automatically unbanned in $duration.");
$self->{pbot}->{conn}->privmsg(
$nick,
"You have been banned from $chan due to join flooding. If your connection issues have been fixed, or this was an accident, you may request an unban at any time by responding to this message with `unbanme`, otherwise you will be automatically unbanned in $duration."
);
} else {
$self->{pbot}->{logger}->log("[anti-flood] I am not an op for ${channel}-floodbans, disregarding join-flood.\n");
}
@ -403,14 +412,17 @@ sub check_flood {
if ($self->{pbot}->{registry}->get_value('antiflood', 'enforce')) {
my $length = $self->{pbot}->{registry}->get_array_value('antiflood', 'chat_flood_punishment', $chan_data->{offenses} - 1);
$self->{pbot}->{chanops}->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'chat flooding', "*!$user\@" . $self->address_to_mask($host), $chan, $length);
$self->{pbot}->{chanops}
->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'chat flooding', "*!$user\@" . $self->address_to_mask($host), $chan, $length);
$length = duration($length);
$self->{pbot}->{logger}->log("$nick $chan flood offense " . $chan_data->{offenses} . " earned $length ban\n");
$self->{pbot}->{conn}->privmsg($nick, "You have been muted due to flooding. Please use a web paste service such as http://codepad.org for lengthy pastes. You will be allowed to speak again in approximately $length.");
$self->{pbot}->{conn}->privmsg(
$nick,
"You have been muted due to flooding. Please use a web paste service such as http://codepad.org for lengthy pastes. You will be allowed to speak again in approximately $length."
);
}
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $chan, $chan_data);
}
else { # private message flood
} else { # private message flood
my $hostmask = $self->address_to_mask($host);
$hostmask =~ s/\*/.*/g;
next if exists $self->{pbot}->{ignorelist}->{ignore_list}->{".*!$user\@$hostmask"}->{$chan};
@ -438,7 +450,8 @@ sub check_flood {
if ($self->{pbot}->{registry}->get_value('antiflood', 'enforce')) {
my $length = $self->{pbot}->{registry}->get_array_value('antiflood', 'nick_flood_punishment', $self->{nickflood}->{$ancestor}->{offenses} - 1);
$self->{pbot}->{chanops}->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'nick flooding', "*!$user\@" . $self->address_to_mask($host), $chan, $length);
$self->{pbot}->{chanops}
->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'nick flooding', "*!$user\@" . $self->address_to_mask($host), $chan, $length);
$length = duration($length);
$self->{pbot}->{logger}->log("$nick nickchange flood offense " . $self->{nickflood}->{$ancestor}->{offenses} . " earned $length ban\n");
$self->{pbot}->{conn}->privmsg($nick, "You have been temporarily banned due to nick-change flooding. You will be unbanned in $length.");
@ -477,10 +490,14 @@ sub check_flood {
my $offenses = $chan_data->{enter_abuses} - $enter_abuse_max_offenses + 1 + $other_offenses;
my $ban_length = $self->{pbot}->{registry}->get_array_value('antiflood', 'enter_abuse_punishment', $offenses - 1);
$self->{pbot}->{chanops}->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'enter abuse', "*!$user\@" . $self->address_to_mask($host), $chan, $ban_length);
$self->{pbot}->{chanops}
->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'enter abuse', "*!$user\@" . $self->address_to_mask($host), $chan, $ban_length);
$ban_length = duration($ban_length);
$self->{pbot}->{logger}->log("$nick $chan enter abuse offense " . $chan_data->{enter_abuses} . " earned $ban_length ban\n");
$self->{pbot}->{conn}->privmsg($nick, "You have been muted due to abusing the enter key. Please do not split your sentences over multiple messages. You will be allowed to speak again in approximately $ban_length.");
$self->{pbot}->{conn}->privmsg(
$nick,
"You have been muted due to abusing the enter key. Please do not split your sentences over multiple messages. You will be allowed to speak again in approximately $ban_length."
);
$chan_data->{last_offense} = gettimeofday;
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $chan, $chan_data);
next;
@ -489,7 +506,10 @@ sub check_flood {
$self->{pbot}->{logger}->log("$nick $chan enter abuses counter incremented to " . $chan_data->{enter_abuses} . "\n") if $debug_enter_abuse;
if ($chan_data->{enter_abuses} == $enter_abuse_max_offenses - 1 && $chan_data->{enter_abuse} == $enter_abuse_threshold / 2 - 1) {
if ($self->{pbot}->{registry}->get_value('antiflood', 'enforce')) {
$self->{pbot}->{conn}->privmsg($chan, "$nick: Please stop abusing the enter key. Feel free to type longer messages and to take a moment to think of anything else to say before you hit that enter key.");
$self->{pbot}->{conn}->privmsg(
$chan,
"$nick: Please stop abusing the enter key. Feel free to type longer messages and to take a moment to think of anything else to say before you hit that enter key."
);
}
}
}
@ -572,14 +592,16 @@ sub unbanme {
}
}
if (keys %$unbanned) {
my $channels = '';
my $sep = '';
my $channels_warning = '';
my $sep_warning = '';
my $channels_disabled = '';
my $sep_disabled = '';
foreach my $channel (keys %$unbanned) {
foreach my $mask (keys %{$unbanned->{$channel}}) {
if ($self->{pbot}->{channels}->is_active_op("${channel}-floodbans")) {
@ -610,18 +632,17 @@ sub unbanme {
my $warning = '';
if (length $channels_warning) {
$warning = " You may use `unbanme` one more time today for $channels_warning; please ensure that your client or connection issues are resolved before using your final `unbanme` of the day.";
$warning =
" You may use `unbanme` one more time today for $channels_warning; please ensure that your client or connection issues are resolved before using your final `unbanme` of the day.";
}
if (length $channels_disabled) {
$warning .= " You may not use `unbanme` again for several hours for $channels_disabled; ensure that your client or connection issues are resolved, otherwise leave the channel until they are or you will be temporarily banned for several hours if you join-flood again during this period.";
$warning .=
" You may not use `unbanme` again for several hours for $channels_disabled; ensure that your client or connection issues are resolved, otherwise leave the channel until they are or you will be temporarily banned for several hours if you join-flood again during this period.";
}
if (length $channels) {
return "/msg $nick You have been unbanned from $channels.$warning";
} else {
return "/msg $nick You were not unbanned at this time.$warning";
}
if (length $channels) { return "/msg $nick You have been unbanned from $channels.$warning"; }
else { return "/msg $nick You were not unbanned at this time.$warning"; }
} else {
return "/msg $nick There is no join-flooding ban set for you.";
}
@ -654,6 +675,7 @@ sub address_to_mask {
}
sub devalidate_accounts {
# remove validation on accounts in $channel that match a ban/quiet $mask
my ($self, $mask, $channel) = @_;
my @message_accounts;
@ -671,6 +693,7 @@ sub devalidate_accounts {
my $channel_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $channel, 'validated');
if (defined $channel_data and $channel_data->{validated} & $self->{NICKSERV_VALIDATED}) {
$channel_data->{validated} &= ~$self->{NICKSERV_VALIDATED};
#$self->{pbot}->{logger}->log("Devalidating account $account\n");
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data);
}
@ -689,7 +712,9 @@ sub check_bans {
my $current_nickserv_account = $self->{pbot}->{messagehistory}->{database}->get_current_nickserv_account($message_account);
$self->{pbot}->{logger}->log("anti-flood: [check-bans] checking for bans on $mask " . (defined $current_nickserv_account and length $current_nickserv_account ? "[$current_nickserv_account] " : "") . "in $channel\n");
$self->{pbot}->{logger}->log("anti-flood: [check-bans] checking for bans on $mask "
. (defined $current_nickserv_account and length $current_nickserv_account ? "[$current_nickserv_account] " : "")
. "in $channel\n");
my ($do_not_validate, $bans);
@ -702,6 +727,7 @@ sub check_bans {
}
} else {
if (not exists $self->{pbot}->{irc_capabilities}->{'account-notify'}) {
# mark this account as needing check-bans when nickserv account is identified
my $channel_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($message_account, $channel, 'validated');
if (not $channel_data->{validated} & $self->{NEEDS_CHECKBAN}) {
@ -731,11 +757,8 @@ sub check_bans {
my @nickservs;
if (exists $aliases{$alias}->{nickserv}) {
@nickservs = split /,/, $aliases{$alias}->{nickserv};
} else {
@nickservs = (undef);
}
if (exists $aliases{$alias}->{nickserv}) { @nickservs = split /,/, $aliases{$alias}->{nickserv}; }
else { @nickservs = (undef); }
foreach my $nickserv (@nickservs) {
my @gecoses;
@ -749,7 +772,8 @@ sub check_bans {
foreach my $gecos (@gecoses) {
my $tgecos = defined $gecos ? $gecos : "[undefined]";
my $tnickserv = defined $nickserv ? $nickserv : "[undefined]";
$self->{pbot}->{logger}->log("anti-flood: [check-bans] checking blacklist for $alias in channel $channel using gecos '$tgecos' and nickserv '$tnickserv'\n") if $debug_checkban >= 5;
$self->{pbot}->{logger}->log("anti-flood: [check-bans] checking blacklist for $alias in channel $channel using gecos '$tgecos' and nickserv '$tnickserv'\n")
if $debug_checkban >= 5;
if ($self->{pbot}->{blacklist}->check_blacklist($alias, $channel, $nickserv, $gecos)) {
my $u = $self->{pbot}->{users}->loggedin($channel, $mask);
if ($self->{pbot}->{capabilities}->userhas($u, 'is-whitelisted')) {
@ -768,13 +792,15 @@ sub check_bans {
}
}
$self->{pbot}->{logger}->log("anti-flood: [check-bans] checking for bans in $channel on $alias using nickserv " . (defined $nickserv ? $nickserv : "[undefined]") . "\n") if $debug_checkban >= 2;
$self->{pbot}->{logger}->log("anti-flood: [check-bans] checking for bans in $channel on $alias using nickserv " . (defined $nickserv ? $nickserv : "[undefined]") . "\n")
if $debug_checkban >= 2;
my $baninfos = $self->{pbot}->{bantracker}->get_baninfo($alias, $channel, $nickserv);
if (defined $baninfos) {
foreach my $baninfo (@$baninfos) {
if (time - $baninfo->{when} < 5) {
$self->{pbot}->{logger}->log("anti-flood: [check-bans] $mask [$alias] evaded $baninfo->{banmask} in $baninfo->{channel}, but within 5 seconds of establishing ban; giving another chance\n");
$self->{pbot}->{logger}
->log("anti-flood: [check-bans] $mask [$alias] evaded $baninfo->{banmask} in $baninfo->{channel}, but within 5 seconds of establishing ban; giving another chance\n");
my $channel_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($message_account, $channel, 'validated');
if ($channel_data->{validated} & $self->{NICKSERV_VALIDATED}) {
$channel_data->{validated} &= ~$self->{NICKSERV_VALIDATED};
@ -787,6 +813,7 @@ sub check_bans {
my $u = $self->{pbot}->{users}->loggedin($baninfo->{channel}, $mask);
my $whitelisted = $self->{pbot}->{capabilities}->userhas($u, 'is-whitelisted');
if ($self->ban_exempted($baninfo->{channel}, $baninfo->{banmask}) || $whitelisted) {
#$self->{pbot}->{logger}->log("anti-flood: [check-bans] $mask [$alias] evaded $baninfo->{banmask} in $baninfo->{channel}, but allowed through whitelist\n");
next;
}
@ -811,11 +838,10 @@ sub check_bans {
next;
}
if (not defined $bans) {
$bans = [];
}
if (not defined $bans) { $bans = []; }
$self->{pbot}->{logger}->log("anti-flood: [check-bans] Hostmask ($mask [$alias" . (defined $nickserv ? "/$nickserv" : "") . "]) matches $baninfo->{type} $baninfo->{banmask}, adding ban\n");
$self->{pbot}->{logger}
->log("anti-flood: [check-bans] Hostmask ($mask [$alias" . (defined $nickserv ? "/$nickserv" : "") . "]) matches $baninfo->{type} $baninfo->{banmask}, adding ban\n");
push @$bans, $baninfo;
goto GOT_BAN;
}
@ -829,17 +855,18 @@ sub check_bans {
my $banmask;
my ($user, $host) = $mask =~ m/[^!]+!([^@]+)@(.*)/;
if ($host =~ m{^([^/]+)/.+} and $1 ne 'gateway' and $1 ne 'nat') {
$banmask = "*!*\@$host";
} elsif ($current_nickserv_account and $baninfo->{banmask} !~ m/^\$a:/i and not exists $self->{pbot}->{bantracker}->{banlist}->{$baninfo->{channel}}->{'+b'}->{"\$a:$current_nickserv_account"}) {
if ($host =~ m{^([^/]+)/.+} and $1 ne 'gateway' and $1 ne 'nat') { $banmask = "*!*\@$host"; }
elsif ( $current_nickserv_account
and $baninfo->{banmask} !~ m/^\$a:/i
and not exists $self->{pbot}->{bantracker}->{banlist}->{$baninfo->{channel}}->{'+b'}->{"\$a:$current_nickserv_account"})
{
$banmask = "\$a:$current_nickserv_account";
} else {
if ($host =~ m{^gateway/web/irccloud.com/}) {
$banmask = "*!$user\@gateway/web/irccloud.com/*";
} elsif ($host =~ m{^nat/([^/]+)/}) {
$banmask = "*!$user\@nat/$1/*";
} else {
if ($host =~ m{^gateway/web/irccloud.com/}) { $banmask = "*!$user\@gateway/web/irccloud.com/*"; }
elsif ($host =~ m{^nat/([^/]+)/}) { $banmask = "*!$user\@nat/$1/*"; }
else {
$banmask = "*!*\@$host";
#$banmask = "*!$user@" . $self->address_to_mask($host);
}
}
@ -865,9 +892,8 @@ sub check_bans {
return;
}
if ($baninfo->{type} eq 'blacklist') {
$self->{pbot}->{chanops}->add_op_command($baninfo->{channel}, "kick $baninfo->{channel} $bannick I don't think so");
} else {
if ($baninfo->{type} eq 'blacklist') { $self->{pbot}->{chanops}->add_op_command($baninfo->{channel}, "kick $baninfo->{channel} $bannick I don't think so"); }
else {
my $owner = $baninfo->{owner};
$owner =~ s/!.*$//;
$self->{pbot}->{chanops}->add_op_command($baninfo->{channel}, "kick $baninfo->{channel} $bannick Evaded $baninfo->{banmask} set by $owner");
@ -932,6 +958,7 @@ sub on_endofwhois {
delete $self->{whois_pending}->{$nick};
my ($id, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($nick);
# $self->{pbot}->{logger}->log("endofwhois: Found [$id][$hostmask] for [$nick]\n");
$self->{pbot}->{messagehistory}->{database}->link_aliases($id, $hostmask) if $id;
@ -940,9 +967,7 @@ sub on_endofwhois {
foreach my $channel (@$channels) {
next unless $channel =~ /^#/;
my $channel_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($id, $channel, 'validated');
if ($channel_data->{validated} & $self->{NEEDS_CHECKBAN} or not $channel_data->{validated} & $self->{NICKSERV_VALIDATED}) {
$self->check_bans($id, $hostmask, $channel);
}
if ($channel_data->{validated} & $self->{NEEDS_CHECKBAN} or not $channel_data->{validated} & $self->{NICKSERV_VALIDATED}) { $self->check_bans($id, $hostmask, $channel); }
}
return 0;
@ -955,9 +980,7 @@ sub on_whoisuser {
my ($id) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($nick);
if ($self->{pbot}->{registry}->get_value('antiflood', 'debug_checkban') >= 2) {
$self->{pbot}->{logger}->log("Got gecos for $nick ($id): '$gecos'\n");
}
if ($self->{pbot}->{registry}->get_value('antiflood', 'debug_checkban') >= 2) { $self->{pbot}->{logger}->log("Got gecos for $nick ($id): '$gecos'\n"); }
$self->{pbot}->{messagehistory}->{database}->update_gecos($id, $gecos, scalar gettimeofday);
}
@ -967,11 +990,10 @@ sub on_whoisaccount {
my $nick = $event->{event}->{args}[1];
my $account = lc $event->{event}->{args}[2];
if ($self->{pbot}->{registry}->get_value('antiflood', 'debug_checkban')) {
$self->{pbot}->{logger}->log("$nick is using NickServ account [$account]\n");
}
if ($self->{pbot}->{registry}->get_value('antiflood', 'debug_checkban')) { $self->{pbot}->{logger}->log("$nick is using NickServ account [$account]\n"); }
my ($id, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($nick);
# $self->{pbot}->{logger}->log("whoisaccount: Found [$id][$hostmask][$account] for [$nick]\n");
$self->{pbot}->{messagehistory}->{database}->link_aliases($id, undef, $account) if $id;
@ -1044,6 +1066,7 @@ sub adjust_offenses {
my $last_offense = delete $channel_data->{last_offense};
if (gettimeofday - $last_offense >= 60 * 60 * 3) {
$channel_data->{enter_abuses}--;
#$self->{pbot}->{logger}->log("[adjust-offenses] [$id][$channel] decreasing enter abuse offenses to $channel_data->{enter_abuses}\n");
$self->{pbot}->{messagehistory}->{database}->update_channel_data($id, $channel, $channel_data);
}
@ -1053,11 +1076,8 @@ sub adjust_offenses {
if ($self->{nickflood}->{$account}->{offenses} and gettimeofday - $self->{nickflood}->{$account}->{timestamp} >= 60 * 60) {
$self->{nickflood}->{$account}->{offenses}--;
if ($self->{nickflood}->{$account}->{offenses} <= 0) {
delete $self->{nickflood}->{$account};
} else {
$self->{nickflood}->{$account}->{timestamp} = gettimeofday;
}
if ($self->{nickflood}->{$account}->{offenses} <= 0) { delete $self->{nickflood}->{$account}; }
else { $self->{nickflood}->{$account}->{timestamp} = gettimeofday; }
}
}
}

31
PBot/AntiSpam.pm
View File

@ -40,9 +40,7 @@ sub is_spam {
my $ret = eval {
foreach my $space ($self->{keywords}->get_keys) {
if ($all_namespaces or $lc_namespace eq $space) {
foreach my $keyword ($self->{keywords}->get_keys($space)) {
return 1 if $text =~ m/$keyword/i;
}
foreach my $keyword ($self->{keywords}->get_keys($space)) { return 1 if $text =~ m/$keyword/i; }
}
}
return 0;
@ -83,9 +81,7 @@ sub antispam_cmd {
my ($namespace, $keyword, $flag, $value) = $self->{pbot}->{interpreter}->split_args($arglist, 4);
return "Usage: antispam set <namespace> <regex> [flag [value]]" if not defined $namespace or not defined $keyword;
if (not $self->{keywords}->exists($namespace)) {
return "There is no such namespace `$namespace`.";
}
if (not $self->{keywords}->exists($namespace)) { return "There is no such namespace `$namespace`."; }
if (not $self->{keywords}->exists($namespace, $keyword)) {
return "There is no such regex `$keyword` for namespace `" . $self->{keywords}->get_data($namespace, '_name') . '`.';
@ -109,11 +105,8 @@ sub antispam_cmd {
if (not defined $value) {
$value = $self->{keywords}->get_data($namespace, $keyword, $flag);
if (not defined $value) {
return "/say $flag is not set.";
} else {
return "/say $flag is set to $value";
}
if (not defined $value) { return "/say $flag is not set."; }
else { return "/say $flag is set to $value"; }
}
$self->{keywords}->set($namespace, $keyword, $flag, $value);
return "Flag set.";
@ -122,17 +115,11 @@ sub antispam_cmd {
my ($namespace, $keyword, $flag) = $self->{pbot}->{interpreter}->split_args($arglist, 3);
return "Usage: antispam unset <namespace> <regex> <flag>" if not defined $namespace or not defined $keyword or not defined $flag;
if (not $self->{keywords}->exists($namespace)) {
return "There is no such namespace `$namespace`.";
}
if (not $self->{keywords}->exists($namespace)) { return "There is no such namespace `$namespace`."; }
if (not $self->{keywords}->exists($namespace, $keyword)) {
return "There is no such keyword `$keyword` for namespace `$namespace`.";
}
if (not $self->{keywords}->exists($namespace, $keyword)) { return "There is no such keyword `$keyword` for namespace `$namespace`."; }
if (not $self->{keywords}->exists($namespace, $keyword, $flag)) {
return "There is no such flag `$flag` for regex `$keyword` for namespace `$namespace`.";
}
if (not $self->{keywords}->exists($namespace, $keyword, $flag)) { return "There is no such flag `$flag` for regex `$keyword` for namespace `$namespace`."; }
return $self->{keywords}->remove($namespace, $keyword, $flag);
}
when ("add") {
@ -150,9 +137,7 @@ sub antispam_cmd {
return "Usage: antispam remove <namespace> <regex>" if not defined $namespace or not defined $keyword;
return $self->{keywords}->remove($namespace, $keyword);
}
default {
return "Unknown command '$command'; commands are: list/show, add, remove";
}
default { return "Unknown command '$command'; commands are: list/show, add, remove"; }
}
}

38
PBot/BanTracker.pm
View File

@ -11,6 +11,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::BanTracker;
use parent 'PBot::Class';
use warnings; use strict;
@ -19,6 +20,7 @@ use feature 'unicode_strings';
use Time::HiRes qw/gettimeofday/;
use Time::Duration;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
sub initialize {
@ -53,7 +55,9 @@ sub get_banlist {
}
sub on_banlist_entry {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{event}->{args}[1];
my $target = lc $event->{event}->{args}[2];
my $source = lc $event->{event}->{args}[3];
@ -87,7 +91,9 @@ sub on_banlist_entry {
}
sub on_quietlist_entry {
my ($self, $event_type, $event) = @_;
my $channel = lc $event->{event}->{args}[1];
my $target = lc $event->{event}->{args}[3];
my $source = lc $event->{event}->{args}[4];
@ -115,11 +121,8 @@ sub get_baninfo {
foreach my $mode (keys %{$self->{banlist}->{$channel}}) {
foreach my $banmask (keys %{$self->{banlist}->{$channel}->{$mode}}) {
if ($banmask =~ m/^\$a:(.*)/) {
$ban_account = lc $1;
} else {
$ban_account = "";
}
if ($banmask =~ m/^\$a:(.*)/) { $ban_account = lc $1; }
else { $ban_account = ""; }
my $banmask_key = $banmask;
$banmask = quotemeta $banmask;
@ -134,15 +137,11 @@ sub get_baninfo {
if ($banmask_key =~ m{\@gateway/web/irccloud.com} and $host =~ m{^gateway/web/irccloud.com}) {
my ($bannick, $banuser, $banhost) = $banmask_key =~ m/([^!]+)!([^@]+)@(.*)/;
if (lc $user eq lc $banuser) {
$banned = 1;
}
if (lc $user eq lc $banuser) { $banned = 1; }
}
if ($banned) {
if (not defined $bans) {
$bans = [];
}
if (not defined $bans) { $bans = []; }
my $baninfo = {};
$baninfo->{banmask} = $banmask_key;
@ -150,6 +149,7 @@ sub get_baninfo {
$baninfo->{owner} = $self->{banlist}->{$channel}->{$mode}->{$banmask_key}->[0];
$baninfo->{when} = $self->{banlist}->{$channel}->{$mode}->{$banmask_key}->[1];
$baninfo->{type} = $mode;
#$self->{pbot}->{logger}->log("get-baninfo: dump: " . Dumper($baninfo) . "\n");
#$self->{pbot}->{logger}->log("get-baninfo: $baninfo->{banmask} $baninfo->{type} in $baninfo->{channel} by $baninfo->{owner} on $baninfo->{when}\n");
@ -205,23 +205,19 @@ sub track_mode {
$self->{pbot}->{logger}->log("ban-tracker: $target " . ($mode eq '+b' ? 'banned' : 'quieted') . " by $source in $channel.\n");
$self->{banlist}->{$channel}->{$mode}->{$target} = [$source, gettimeofday];
$self->{pbot}->{antiflood}->devalidate_accounts($target, $channel);
}
elsif ($mode eq "-b" or $mode eq "-q") {
} elsif ($mode eq "-b" or $mode eq "-q") {
$self->{pbot}->{logger}->log("ban-tracker: $target " . ($mode eq '-b' ? 'unbanned' : 'unquieted') . " by $source in $channel.\n");
delete $self->{banlist}->{$channel}->{$mode eq "-b" ? "+b" : "+q"}->{$target};
if ($mode eq "-b") {
if ($self->{pbot}->{chanops}->{unban_timeout}->exists($channel, $target)) {
$self->{pbot}->{chanops}->{unban_timeout}->remove($channel, $target);
} elsif ($self->{pbot}->{chanops}->{unban_timeout}->exists($channel, "$target\$##stop_join_flood")) {
if ($self->{pbot}->{chanops}->{unban_timeout}->exists($channel, $target)) { $self->{pbot}->{chanops}->{unban_timeout}->remove($channel, $target); }
elsif ($self->{pbot}->{chanops}->{unban_timeout}->exists($channel, "$target\$##stop_join_flood")) {
# freenode strips channel forwards from unban result if no ban exists with a channel forward
$self->{pbot}->{chanops}->{unban_timeout}->remove($channel, "$target\$##stop_join_flood");
}
}
elsif ($mode eq "-q") {
if ($self->{pbot}->{chanops}->{unmute_timeout}->exists($channel, $target)) {
$self->{pbot}->{chanops}->{unmute_timeout}->remove($channel, $target);
}
} elsif ($mode eq "-q") {
if ($self->{pbot}->{chanops}->{unmute_timeout}->exists($channel, $target)) { $self->{pbot}->{chanops}->{unmute_timeout}->remove($channel, $target); }
}
} else {
$self->{pbot}->{logger}->log("BanTracker: Unknown mode '$mode'\n");

33
PBot/BlackList.pm
View File

@ -43,9 +43,7 @@ sub remove {
if (exists $self->{blacklist}->{$channel}) {
delete $self->{blacklist}->{$channel}->{$hostmask};
if (keys %{ $self->{blacklist}->{$channel} } == 0) {
delete $self->{blacklist}->{$channel};
}
if (keys %{$self->{blacklist}->{$channel}} == 0) { delete $self->{blacklist}->{$channel}; }
}
$self->save_blacklist();
}
@ -58,7 +56,8 @@ sub clear_blacklist {
sub load_blacklist {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
if (not defined $filename) {
$self->{pbot}->{logger}->log("No blacklist path specified -- skipping loading of blacklist");
@ -79,13 +78,9 @@ sub load_blacklist {
my ($channel, $hostmask) = split(/\s+/, $line);
if (not defined $hostmask || not defined $channel) {
Carp::croak "Syntax error around line $i of $filename\n";
}
if (not defined $hostmask || not defined $channel) { Carp::croak "Syntax error around line $i of $filename\n"; }
if (exists $self->{blacklist}->{$channel}->{$hostmask}) {
Carp::croak "Duplicate blacklist entry [$hostmask][$channel] found in $filename around line $i\n";
}
if (exists $self->{blacklist}->{$channel}->{$hostmask}) { Carp::croak "Duplicate blacklist entry [$hostmask][$channel] found in $filename around line $i\n"; }
$self->{blacklist}->{$channel}->{$hostmask} = 1;
}
@ -97,7 +92,8 @@ sub save_blacklist {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
if (not defined $filename) {
$self->{pbot}->{logger}->log("No blacklist path specified -- skipping saving of blacklist\n");
@ -107,9 +103,7 @@ sub save_blacklist {
open(FILE, "> $filename") or die "Couldn't open $filename: $!\n";
foreach my $channel (keys %{$self->{blacklist}}) {
foreach my $hostmask (keys %{ $self->{blacklist}->{$channel} }) {
print FILE "$channel $hostmask\n";
}
foreach my $hostmask (keys %{$self->{blacklist}->{$channel}}) { print FILE "$channel $hostmask\n"; }
}
close(FILE);
@ -164,11 +158,8 @@ sub blacklist {
my $text = "Blacklist:\n";
my $entries = 0;
foreach my $channel (sort keys %{$self->{blacklist}}) {
if ($channel eq '.*') {
$text .= " all channels:\n";
} else {
$text .= " $channel:\n";
}
if ($channel eq '.*') { $text .= " all channels:\n"; }
else { $text .= " $channel:\n"; }
foreach my $mask (sort keys %{$self->{blacklist}->{$channel}}) {
$text .= " $mask,\n";
$entries++;
@ -202,9 +193,7 @@ sub blacklist {
$self->{pbot}->{logger}->log("$nick!$user\@$host removed [$mask] from blacklist for channel [$channel]\n");
return "/say $mask removed from blacklist for channel $channel";
}
default {
return "Unknown command '$command'; commands are: list/show, add, remove";
}
default { return "Unknown command '$command'; commands are: list/show, add, remove"; }
}
}

71
PBot/Capabilities.pm
View File

@ -21,6 +21,7 @@ sub initialize {
my $filename = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/capabilities';
$self->{caps} = PBot::HashObject->new(name => 'Capabilities', filename => $filename, pbot => $self->{pbot});
$self->{caps}->load;
# 'cap' command registered in PBot.pm because $self->{pbot}->{commands} is not yet loaded.
# add some capabilities used in this file
@ -68,9 +69,7 @@ sub exists {
$cap = lc $cap;
foreach my $c ($self->{caps}->get_keys) {
return 1 if $c eq $cap;
foreach my $sub_cap ($self->{caps}->get_keys($c)) {
return 1 if $sub_cap eq $cap;
}
foreach my $sub_cap ($self->{caps}->get_keys($c)) { return 1 if $sub_cap eq $cap; }
}
return 0;
}
@ -78,15 +77,10 @@ sub exists {
sub add {
my ($self, $cap, $subcap, $dontsave) = @_;
if (not defined $subcap) {
if (not $self->{caps}->exists($cap)) {
$self->{caps}->add($cap, {}, $dontsave);
}
if (not $self->{caps}->exists($cap)) { $self->{caps}->add($cap, {}, $dontsave); }
} else {
if ($self->{caps}->exists($cap)) {
$self->{caps}->set($cap, $subcap, 1, $dontsave);
} else {
$self->{caps}->add($cap, { $subcap => 1 }, $dontsave);
}
if ($self->{caps}->exists($cap)) { $self->{caps}->set($cap, $subcap, 1, $dontsave); }
else { $self->{caps}->add($cap, {$subcap => 1}, $dontsave); }
}
}
@ -95,9 +89,7 @@ sub remove {
$cap = lc $cap;
if (not defined $subcap) {
foreach my $c ($self->{caps}->get_keys) {
foreach my $sub_cap ($self->{caps}->get_keys($c)) {
$self->{caps}->remove($c, $sub_cap, 1) if $sub_cap eq $cap;
}
foreach my $sub_cap ($self->{caps}->get_keys($c)) { $self->{caps}->remove($c, $sub_cap, 1) if $sub_cap eq $cap; }
$self->{caps}->remove($c, undef, 1) if $c eq $cap;
}
} else {
@ -109,9 +101,7 @@ sub remove {
sub rebuild_botowner_capabilities {
my ($self) = @_;
$self->{caps}->remove('botowner', undef, 1);
foreach my $cap ($self->{caps}->get_keys) {
$self->add('botowner', $cap, 1);
}
foreach my $cap ($self->{caps}->get_keys) { $self->add('botowner', $cap, 1); }
}
sub list {
@ -136,11 +126,8 @@ sub list {
# then list stand-alone capabilities
foreach my $cap (@caps) {
my $count = $self->{caps}->get_keys($cap);
if ($count > 0) {
push @groups, "$cap ($count cap" . ($count == 1 ? '' : 's') . ")" if $count;
} else {
push @standalones, $cap;
}
if ($count > 0) { push @groups, "$cap ($count cap" . ($count == 1 ? '' : 's') . ")" if $count; }
else { push @standalones, $cap; }
}
$result .= join ', ', @groups, @standalones;
return $result;
@ -190,16 +177,13 @@ sub capcmd {
my $u = $self->{pbot}->{users}->find_user($from, $hostmask, 1);
if (not defined $u) {
$from = 'global' if $from !~ /^#/;
return "No such user $hostmask in $from."
return "No such user $hostmask in $from.";
}
if (defined $cap) {
return "Try again. No such capability $cap." if not $self->exists($cap);
if ($self->userhas($u, $cap)) {
return "Yes. User $u->{name} has capability $cap.";
} else {
return "No. User $u->{name} does not have capability $cap.";
}
if ($self->userhas($u, $cap)) { return "Yes. User $u->{name} has capability $cap."; }
else { return "No. User $u->{name} does not have capability $cap."; }
} else {
my $result = "User $u->{name} has capabilities: ";
my @groups;
@ -208,17 +192,11 @@ sub capcmd {
next if $key eq '_name';
next if not $self->exists($key);
my $count = $self->{caps}->get_keys;
if ($count > 0) {
push @groups, "$key ($count cap" . ($count == 1 ? '' : 's') . ")";
} else {
push @single, $key;
}
}
if (@groups or @single) {
$result .= join ', ', @groups, @single;
} else {
$result = "User $u->{name} has no capabilities.";
if ($count > 0) { push @groups, "$key ($count cap" . ($count == 1 ? '' : 's') . ")"; }
else { push @single, $key; }
}
if (@groups or @single) { $result .= join ', ', @groups, @single; }
else { $result = "User $u->{name} has no capabilities."; }
return $result;
}
}
@ -237,11 +215,8 @@ sub capcmd {
return "You cannot group a capability with itself." if lc $cap eq lc $c;
$self->add($cap, $c);
}
if (@caps > 1) {
return "Capabilities " . join(', ', @caps) . " added to the $cap capability group.";
} else {
return "Capability $subcaps added to the $cap capability group.";
}
if (@caps > 1) { return "Capabilities " . join(', ', @caps) . " added to the $cap capability group."; }
else { return "Capability $subcaps added to the $cap capability group."; }
}
when ('ungroup') {
@ -260,15 +235,13 @@ sub capcmd {
$self->remove($cap, $c);
}
if (@caps > 1) {
return "Capabilities " . join(', ', @caps) . " removed from the $cap capability group.";
} else {
return "Capability $subcaps removed from the $cap capability group.";
}
if (@caps > 1) { return "Capabilities " . join(', ', @caps) . " removed from the $cap capability group."; }
else { return "Capability $subcaps removed from the $cap capability group."; }
}
default {
$result = "Usage: cap list [capability] | cap group <existing or new capability group> <existing capabilities...> | cap ungroup <existing capability group> <grouped capabilities...> | cap userhas <user> [capability] | cap whohas <capability>";
$result =
"Usage: cap list [capability] | cap group <existing or new capability group> <existing capabilities...> | cap ungroup <existing capability group> <grouped capabilities...> | cap userhas <user> [capability] | cap whohas <capability>";
}
}
return $result;

129
PBot/ChanOpCommands.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::ChanOpCommands;
use parent 'PBot::Class';
use warnings; use strict;
@ -18,6 +19,7 @@ use Time::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
# register commands
$self->{pbot}->{commands}->register(sub { $self->ban_user(@_) }, "ban", 1);
$self->{pbot}->{commands}->register(sub { $self->unban_user(@_) }, "unban", 1);
@ -44,9 +46,7 @@ sub initialize {
$self->{pbot}->{capabilities}->add('can-devoice', 'can-mode-v', 1);
# create can-mode-any capabilities group
foreach my $mode ("a" .. "z", "A" .. "Z") {
$self->{pbot}->{capabilities}->add('can-mode-any', "can-mode-$mode", 1);
}
foreach my $mode ("a" .. "z", "A" .. "Z") { $self->{pbot}->{capabilities}->add('can-mode-any', "can-mode-$mode", 1); }
$self->{pbot}->{capabilities}->add('can-mode-any', 'can-mode', 1);
# add to chanop capabilities group
@ -138,6 +138,7 @@ sub invite {
my ($channel, $target);
if ($from !~ m/^#/) {
# from /msg
my $usage = "Usage from /msg: invite <channel> [nick]; if you omit [nick] then you will be invited";
return $usage if not length $arguments;
@ -145,8 +146,10 @@ sub invite {
return "$channel is not a channel; $usage" if $channel !~ m/^#/;
$target = $nick if not defined $target;
} else {
# in channel
return "Usage: invite [channel] <nick>" if not length $arguments;
# add current channel as default channel
$self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $from) if $stuff->{arglist}[0] !~ m/^#/;
($channel, $target) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
@ -165,24 +168,18 @@ sub generic_mode_user {
my ($flag, $mode_char) = $mode_flag =~ m/(.)(.)/;
if ($channel !~ m/^#/) {
# from message
$channel = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist});
if (not defined $channel) {
return "Usage from message: $mode_name <channel> [nick]";
} elsif ($channel !~ m/^#/) {
return "$channel is not a channel. Usage from message: $mode_name <channel> [nick]";
}
if (not defined $channel) { return "Usage from message: $mode_name <channel> [nick]"; }
elsif ($channel !~ m/^#/) { return "$channel is not a channel. Usage from message: $mode_name <channel> [nick]"; }
}
$channel = lc $channel;
if (not $self->{pbot}->{chanops}->can_gain_ops($channel)) {
return "I am not configured as an OP for $channel. See `chanset` command for more information.";
}
if (not $self->{pbot}->{chanops}->can_gain_ops($channel)) { return "I am not configured as an OP for $channel. See `chanset` command for more information."; }
# add $nick to $args if no argument
if (not $self->{pbot}->{interpreter}->arglist_size($stuff->{arglist})) {
$self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $nick);
}
if (not $self->{pbot}->{interpreter}->arglist_size($stuff->{arglist})) { $self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $nick); }
my $max_modes = $self->{pbot}->{ircd}->{MODES} // 1;
my $mode = $flag;
@ -239,17 +236,12 @@ sub devoice_user {
sub mode {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
if (not length $arguments) {
return "Usage: mode [channel] <arguments>";
}
if (not length $arguments) { return "Usage: mode [channel] <arguments>"; }
# add current channel as default channel
if ($stuff->{arglist}[0] !~ m/^#/) {
if ($from =~ m/^#/) {
$self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $from);
} else {
return "Usage from private message: mode <channel> <arguments>";
}
if ($from =~ m/^#/) { $self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $from); }
else { return "Usage from private message: mode <channel> <arguments>"; }
}
my ($channel, $modes, $args) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 3);
@ -279,14 +271,13 @@ sub mode {
my $target = $targets[$arg++] // "";
if (($mode eq 'v' or $mode eq 'o') and $target =~ m/\*/) {
# wildcard used; find all matching nicks; test against whitelist, etc
my $q_target = lc quotemeta $target;
$q_target =~ s/\\\*/.*/g;
$channel = lc $channel;
if (not exists $self->{pbot}->{nicklist}->{nicklist}->{$channel}) {
return "I have no nicklist for channel $channel; cannot use wildcard.";
}
if (not exists $self->{pbot}->{nicklist}->{nicklist}->{$channel}) { return "I have no nicklist for channel $channel; cannot use wildcard."; }
my $u = $self->{pbot}->{users}->loggedin($channel, "$nick!$user\@$host");
if ($mode eq 'v') {
@ -304,6 +295,7 @@ sub mode {
my $nick_data = $self->{pbot}->{nicklist}->{nicklist}->{$channel}->{$n};
if ($modifier eq '-') {
# removing mode -- check against whitelist, etc
next if $nick_data->{nick} eq $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $u = $self->{pbot}->{users}->loggedin($channel, $nick_data->{hostmask});
@ -311,11 +303,8 @@ sub mode {
}
# skip nick if already has mode set/unset
if ($modifier eq '+') {
next if exists $nick_data->{"+$mode"};
} else {
next unless exists $nick_data->{"+$mode"};
}
if ($modifier eq '+') { next if exists $nick_data->{"+$mode"}; }
else { next unless exists $nick_data->{"+$mode"}; }
$new_modes = $modifier if not length $new_modes;
$new_modes .= $mode;
@ -331,6 +320,7 @@ sub mode {
}
}
} else {
# no wildcard used; explicit mode requested - no whitelist checking
$new_modes .= $mode;
$new_targets .= "$target " if length $target;
@ -345,17 +335,12 @@ sub mode {
}
}
if ($i) {
$self->{pbot}->{chanops}->add_op_command($channel, "mode $channel $new_modes $new_targets");
}
if ($i) { $self->{pbot}->{chanops}->add_op_command($channel, "mode $channel $new_modes $new_targets"); }
$self->{pbot}->{chanops}->gain_ops($channel);
if ($from !~ m/^#/) {
return "Done.";
} else {
return "";
}
if ($from !~ m/^#/) { return "Done."; }
else { return ""; }
}
sub checkban {
@ -400,14 +385,12 @@ sub ban_user {
$channel = exists $stuff->{admin_channel_override} ? $stuff->{admin_channel_override} : $from if not defined $channel or not length $channel;
if (not defined $target) {
return "Usage: ban <mask> [channel [timeout (default: 24 hours)]]";
}
if (not defined $target) { return "Usage: ban <mask> [channel [timeout (default: 24 hours)]]"; }
my $no_length = 0;
if (not defined $length) {
$length = $self->{pbot}->{registry}->get_value($channel, 'default_ban_timeout', 0, $stuff) //
$self->{pbot}->{registry}->get_value('general', 'default_ban_timeout', 0, $stuff) // 60 * 60 * 24; # 24 hours
$length = $self->{pbot}->{registry}->get_value($channel, 'default_ban_timeout', 0, $stuff)
// $self->{pbot}->{registry}->get_value('general', 'default_ban_timeout', 0, $stuff) // 60 * 60 * 24; # 24 hours
$no_length = 1;
} else {
my $error;
@ -426,6 +409,7 @@ sub ban_user {
my @targets = split /,/, $target;
my $immediately = @targets > 1 ? 0 : 1;
my $duration;
foreach my $t (@targets) {
my $mask = lc $self->{pbot}->{chanops}->nick_to_banmask($t);
@ -473,9 +457,7 @@ sub unban_user {
$channel = $temp;
}
if (not defined $target) {
return "Usage: unban <nick/mask> [channel [false value to use unban queue]]";
}
if (not defined $target) { return "Usage: unban <nick/mask> [channel [false value to use unban queue]]"; }
$channel = exists $stuff->{admin_channel_override} ? $stuff->{admin_channel_override} : $from if not defined $channel;
$immediately = 1 if not defined $immediately;
@ -494,9 +476,7 @@ sub unban_user {
$channel = lc $channel;
if (exists $self->{pbot}->{bantracker}->{banlist}->{$channel} && exists $self->{pbot}->{bantracker}->{banlist}->{$channel}->{'+b'}) {
$immediately = 0;
foreach my $banmask (keys %{ $self->{pbot}->{bantracker}->{banlist}->{$channel}->{'+b'} }) {
$self->{pbot}->{chanops}->unban_user($banmask, $channel, $immediately);
}
foreach my $banmask (keys %{$self->{pbot}->{bantracker}->{banlist}->{$channel}->{'+b'}}) { $self->{pbot}->{chanops}->unban_user($banmask, $channel, $immediately); }
last;
}
} else {
@ -517,9 +497,7 @@ sub mute_user {
return "";
}
if (not defined $channel and $from !~ m/^#/) {
return "Usage from private message: mute <mask> <channel> [timeout (default: 24 hours)]";
}
if (not defined $channel and $from !~ m/^#/) { return "Usage from private message: mute <mask> <channel> [timeout (default: 24 hours)]"; }
if ($channel !~ m/^#/) {
$length = "$channel $length";
@ -529,18 +507,14 @@ sub mute_user {
$channel = exists $stuff->{admin_channel_override} ? $stuff->{admin_channel_override} : $from if not defined $channel;
if ($channel !~ m/^#/) {
return "Please specify a channel.";
}
if ($channel !~ m/^#/) { return "Please specify a channel."; }
if (not defined $target) {
return "Usage: mute <mask> [channel [timeout (default: 24 hours)]]";
}
if (not defined $target) { return "Usage: mute <mask> [channel [timeout (default: 24 hours)]]"; }
my $no_length = 0;
if (not defined $length) {
$length = $self->{pbot}->{registry}->get_value($channel, 'default_mute_timeout', 0, $stuff) //
$self->{pbot}->{registry}->get_value('general', 'default_mute_timeout', 0, $stuff) // 60 * 60 * 24; # 24 hours
$length = $self->{pbot}->{registry}->get_value($channel, 'default_mute_timeout', 0, $stuff)
// $self->{pbot}->{registry}->get_value('general', 'default_mute_timeout', 0, $stuff) // 60 * 60 * 24; # 24 hours
$no_length = 1;
} else {
my $error;
@ -559,6 +533,7 @@ sub mute_user {
my @targets = split /,/, $target;
my $immediately = @targets > 1 ? 0 : 1;
my $duration;
foreach my $t (@targets) {
my $mask = lc $self->{pbot}->{chanops}->nick_to_banmask($t);
@ -606,9 +581,7 @@ sub unmute_user {
$channel = $temp;
}
if (not defined $target) {
return "Usage: unmute <nick/mask> [channel [false value to use unban queue]]";
}
if (not defined $target) { return "Usage: unmute <nick/mask> [channel [false value to use unban queue]]"; }
$channel = exists $stuff->{admin_channel_override} ? $stuff->{admin_channel_override} : $from if not defined $channel;
$immediately = 1 if not defined $immediately;
@ -627,9 +600,7 @@ sub unmute_user {
$channel = lc $channel;
if (exists $self->{pbot}->{bantracker}->{banlist}->{$channel} && exists $self->{pbot}->{bantracker}->{banlist}->{$channel}->{'+q'}) {
$immediately = 0;
foreach my $banmask (keys %{ $self->{pbot}->{bantracker}->{banlist}->{$channel}->{'+q'} }) {
$self->{pbot}->{chanops}->unmute_user($banmask, $channel, $immediately);
}
foreach my $banmask (keys %{$self->{pbot}->{bantracker}->{banlist}->{$channel}->{'+q'}}) { $self->{pbot}->{chanops}->unmute_user($banmask, $channel, $immediately); }
last;
}
} else {
@ -653,29 +624,23 @@ sub kick_user {
my ($channel, $victim, $reason);
if (not $from =~ /^#/) {
# used in private message
if (not $arguments =~ s/^(^#\S+) (\S+)\s*//) {
return "Usage from private message: kick <channel> <nick> [reason]";
}
if (not $arguments =~ s/^(^#\S+) (\S+)\s*//) { return "Usage from private message: kick <channel> <nick> [reason]"; }
($channel, $victim) = ($1, $2);
} else {
# used in channel
if ($arguments =~ s/^(#\S+)\s+(\S+)\s*//) {
($channel, $victim) = ($1, $2);
} elsif ($arguments =~ s/^(\S+)\s*//) {
($victim, $channel) = ($1, exists $stuff->{admin_channel_override} ? $stuff->{admin_channel_override} : $from);
} else {
return "Usage: kick [channel] <nick> [reason]";
}
if ($arguments =~ s/^(#\S+)\s+(\S+)\s*//) { ($channel, $victim) = ($1, $2); }
elsif ($arguments =~ s/^(\S+)\s*//) { ($victim, $channel) = ($1, exists $stuff->{admin_channel_override} ? $stuff->{admin_channel_override} : $from); }
else { return "Usage: kick [channel] <nick> [reason]"; }
}
$reason = $arguments;
# If the user is too stupid to remember the order of the arguments,
# we can help them out by seeing if they put the channel in the reason.
if ($reason =~ s/^(#\S+)\s*//) {
$channel = $1;
}
if ($reason =~ s/^(#\S+)\s*//) { $channel = $1; }
my @insults;
if (not length $reason) {
@ -692,14 +657,13 @@ sub kick_user {
my @nicks = split /,/, $victim;
foreach my $n (@nicks) {
if ($n =~ m/\*/) {
# wildcard used; find all matching nicks; test against whitelist, etc
my $q_target = lc quotemeta $n;
$q_target =~ s/\\\*/.*/g;
$channel = lc $channel;
if (not exists $self->{pbot}->{nicklist}->{nicklist}->{$channel}) {
return "I have no nicklist for channel $channel; cannot use wildcard.";
}
if (not exists $self->{pbot}->{nicklist}->{nicklist}->{$channel}) { return "I have no nicklist for channel $channel; cannot use wildcard."; }
my $u = $self->{pbot}->{users}->loggedin($channel, "$nick!$user\@$host");
if (not $self->{pbot}->{capabilities}->userhas($u, 'can-kick-wildcard')) {
@ -718,6 +682,7 @@ sub kick_user {
}
}
} else {
# no wildcard used, explicit kick
$self->{pbot}->{chanops}->add_op_command($channel, "kick $channel $n $reason");
}

66
PBot/ChanOps.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::ChanOps;
use parent 'PBot::Class';
use warnings; use strict;
@ -56,7 +57,8 @@ sub initialize {
sub can_gain_ops {
my ($self, $channel) = @_;
$channel = lc $channel;
return $self->{pbot}->{channels}->{channels}->exists($channel)
return
$self->{pbot}->{channels}->{channels}->exists($channel)
&& $self->{pbot}->{channels}->{channels}->get_data($channel, 'chanop')
&& $self->{pbot}->{channels}->{channels}->get_data($channel, 'enabled');
}
@ -69,11 +71,9 @@ sub gain_ops {
return if exists $self->{op_requested}->{$channel};
return if not $self->can_gain_ops($channel);
my $op_nick = $self->{pbot}->{registry}->get_value($channel, 'op_nick') //
$self->{pbot}->{registry}->get_value('general', 'op_nick') // 'chanserv';
my $op_nick = $self->{pbot}->{registry}->get_value($channel, 'op_nick') // $self->{pbot}->{registry}->get_value('general', 'op_nick') // 'chanserv';
my $op_command = $self->{pbot}->{registry}->get_value($channel, 'op_command') //
$self->{pbot}->{registry}->get_value('general', 'op_command') // "op $channel";
my $op_command = $self->{pbot}->{registry}->get_value($channel, 'op_command') // $self->{pbot}->{registry}->get_value('general', 'op_command') // "op $channel";
$op_command =~ s/\$channel\b/$channel/g;
@ -125,9 +125,7 @@ sub ban_user {
my $self = shift;
my ($mask, $channel, $immediately) = @_;
$self->add_to_ban_queue($channel, 'b', $mask);
if (not defined $immediately or $immediately != 0) {
$self->check_ban_queue;
}
if (not defined $immediately or $immediately != 0) { $self->check_ban_queue; }
}
sub get_bans {
@ -155,7 +153,7 @@ sub get_bans {
}
}
}
return $masks
return $masks;
}
sub unmode_user {
@ -191,9 +189,8 @@ sub nick_to_banmask {
my ($message_account, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($mask);
if (defined $hostmask) {
my $nickserv = $self->{pbot}->{messagehistory}->{database}->get_current_nickserv_account($message_account);
if (defined $nickserv && length $nickserv) {
$mask = '$a:' . $nickserv;
} else {
if (defined $nickserv && length $nickserv) { $mask = '$a:' . $nickserv; }
else {
my ($nick, $user, $host) = $hostmask =~ m/([^!]+)!([^@]+)@(.*)/;
$mask = "*!$user\@" . $self->{pbot}->{antiflood}->address_to_mask($host);
}
@ -223,16 +220,12 @@ sub ban_user_timed {
$self->ban_user($mask, $channel, $immediately);
if ($length > 0) {
my $data = {
timeout => gettimeofday + $length
};
my $data = {timeout => gettimeofday + $length};
$data->{owner} = $owner if defined $owner;
$data->{reason} = $reason if defined $reason;
$self->{unban_timeout}->add($channel, $mask, $data);
} else {
if ($self->{unban_timeout}->exists($channel, $mask)) {
$self->{unban_timeout}->remove($channel, $mask);
}
if ($self->{unban_timeout}->exists($channel, $mask)) { $self->{unban_timeout}->remove($channel, $mask); }
}
}
@ -241,12 +234,14 @@ sub checkban {
my $mask = $self->nick_to_banmask($target);
if ($self->{unban_timeout}->exists($channel, $mask)) {
my $timeout = $self->{unban_timeout}->get_data($channel, $mask, 'timeout');
my $owner = $self->{unban_timeout}->get_data($channel, $mask, 'owner');
my $reason = $self->{unban_timeout}->get_data($channel, $mask, 'reason');
my $duration = concise duration($timeout - gettimeofday);
my $result = "$mask banned in $channel ";
$result .= "by $owner " if defined $owner;
$result .= "for $reason " if defined $reason;
$result .= "($duration remaining)";
@ -260,9 +255,7 @@ sub mute_user {
my $self = shift;
my ($mask, $channel, $immediately) = @_;
$self->add_to_ban_queue($channel, 'q', $mask);
if (not defined $immediately or $immediately != 0) {
$self->check_ban_queue;
}
if (not defined $immediately or $immediately != 0) { $self->check_ban_queue; }
}
sub unmute_user {
@ -281,16 +274,12 @@ sub mute_user_timed {
$self->mute_user($mask, $channel, $immediately);
if ($length > 0) {
my $data = {
timeout => gettimeofday + $length
};
my $data = {timeout => gettimeofday + $length};
$data->{owner} = $owner if defined $owner;
$data->{reason} = $reason if defined $reason;
$self->{unmute_timeout}->add($channel, $mask, $data);
} else {
if ($self->{unmute_timeout}->exists($channel, $mask)) {
$self->{unmute_timeout}->remove($channel, $mask);
}
if ($self->{unmute_timeout}->exists($channel, $mask)) { $self->{unmute_timeout}->remove($channel, $mask); }
}
}
@ -299,12 +288,14 @@ sub checkmute {
my $mask = $self->nick_to_banmask($target);
if ($self->{unmute_timeout}->exists($channel, $mask)) {
my $timeout = $self->{unmute_timeout}->get_data($channel, $mask, 'timeout');
my $owner = $self->{unmute_timeout}->get_data($channel, $mask, 'owner');
my $reason = $self->{unmute_timeout}->get_data($channel, $mask, 'reason');
my $duration = concise duration($timeout - gettimeofday);
my $result = "$mask muted in $channel ";
$result .= "by $owner " if defined $owner;
$result .= "for $reason " if defined $reason;
$result .= "($duration remaining)";
@ -327,10 +318,7 @@ sub join_channel {
delete $self->{is_opped}->{$channel};
delete $self->{op_requested}->{$channel};
if ($self->{pbot}->{channels}->{channels}->exists($channel)
and $self->{pbot}->{channels}->{channels}->get_data($channel, 'permop')) {
$self->gain_ops($channel);
}
if ($self->{pbot}->{channels}->{channels}->exists($channel) and $self->{pbot}->{channels}->{channels}->get_data($channel, 'permop')) { $self->gain_ops($channel); }
$self->{pbot}->{conn}->mode($channel);
}
@ -383,9 +371,7 @@ sub check_ban_queue {
last if ++$count >= $self->{pbot}->{ircd}->{MODES};
}
if (not @{$self->{ban_queue}->{$channel}->{$mode}}) {
delete $self->{ban_queue}->{$channel}->{$mode};
}
if (not @{$self->{ban_queue}->{$channel}->{$mode}}) { delete $self->{ban_queue}->{$channel}->{$mode}; }
last if $count >= $self->{pbot}->{ircd}->{MODES};
}
@ -433,9 +419,7 @@ sub check_unban_queue {
last if ++$count >= $self->{pbot}->{ircd}->{MODES};
}
if (not @{$self->{unban_queue}->{$channel}->{$mode}}) {
delete $self->{unban_queue}->{$channel}->{$mode};
}
if (not @{$self->{unban_queue}->{$channel}->{$mode}}) { delete $self->{unban_queue}->{$channel}->{$mode}; }
last if $count >= $self->{pbot}->{ircd}->{MODES};
}
@ -488,17 +472,13 @@ sub check_opped_timeouts {
my $now = gettimeofday();
foreach my $channel (keys %{$self->{is_opped}}) {
if ($self->{is_opped}->{$channel}{timeout} < $now) {
unless ($self->{pbot}->{channels}->{channels}->exists($channel)
and $self->{pbot}->{channels}->{channels}->get_data($channel, 'permop')) {
$self->lose_ops($channel);
}
unless ($self->{pbot}->{channels}->{channels}->exists($channel) and $self->{pbot}->{channels}->{channels}->get_data($channel, 'permop')) { $self->lose_ops($channel); }
}
}
foreach my $channel (keys %{$self->{op_requested}}) {
if ($now - $self->{op_requested}->{$channel} > 60 * 5) {
if ($self->{pbot}->{channels}->{channels}->exists($channel)
and $self->{pbot}->{channels}->{channels}->get_data($channel, 'enabled')) {
if ($self->{pbot}->{channels}->{channels}->exists($channel) and $self->{pbot}->{channels}->{channels}->get_data($channel, 'enabled')) {
$self->{pbot}->{logger}->log("5 minutes since OP request for $channel and no OP yet; trying again ...\n");
delete $self->{op_requested}->{$channel};
$self->gain_ops($channel);

13
PBot/Channels.pm
View File

@ -82,14 +82,10 @@ sub remove {
return "Usage: chanrem <channel>" if not defined $arguments or not length $arguments;
# clear unban timeouts
if ($self->{pbot}->{chanops}->{unban_timeout}->exists($arguments)) {
$self->{pbot}->{chanops}->{unban_timeout}->remove($arguments);
}
if ($self->{pbot}->{chanops}->{unban_timeout}->exists($arguments)) { $self->{pbot}->{chanops}->{unban_timeout}->remove($arguments); }
# clear unmute timeouts
if ($self->{pbot}->{chanops}->{unmute_timeout}->exists($arguments)) {
$self->{pbot}->{chanops}->{unmute_timeout}->remove($arguments);
}
if ($self->{pbot}->{chanops}->{unmute_timeout}->exists($arguments)) { $self->{pbot}->{chanops}->{unmute_timeout}->remove($arguments); }
# TODO: ignores, etc?
return $self->{channels}->remove($arguments);
@ -115,9 +111,7 @@ sub autojoin {
return if $self->{pbot}->{joined_channels};
my $channels;
foreach my $channel ($self->{channels}->get_keys) {
if ($self->{channels}->get_data($channel, 'enabled')) {
$channels .= $self->{channels}->get_data($channel, '_name') . ',';
}
if ($self->{channels}->get_data($channel, 'enabled')) { $channels .= $self->{channels}->get_data($channel, '_name') . ','; }
}
$self->{pbot}->{logger}->log("Joining channels: $channels\n");
$self->{pbot}->{chanops}->join_channel($channels);
@ -126,6 +120,7 @@ sub autojoin {
sub is_active {
my ($self, $channel) = @_;
# returns undef if channel doesn't exist; otherwise, the value of 'enabled'
return $self->{channels}->get_data($channel, 'enabled');
}

44
PBot/Commands.pm
View File

@ -41,12 +41,9 @@ sub register {
$ref->{name} = lc $name;
$ref->{requires_cap} = $requires_cap // 0;
if (not $self->{metadata}->exists($name)) {
$self->{metadata}->add($name, { requires_cap => $requires_cap, help => '' }, 1);
} else {
if (not defined $self->get_meta($name, 'requires_cap')) {
$self->{metadata}->set($name, 'requires_cap', $requires_cap, 1);
}
if (not $self->{metadata}->exists($name)) { $self->{metadata}->add($name, {requires_cap => $requires_cap, help => ''}, 1); }
else {
if (not defined $self->get_meta($name, 'requires_cap')) { $self->{metadata}->set($name, 'requires_cap', $requires_cap, 1); }
}
# add can-cmd capability
@ -64,9 +61,7 @@ sub unregister {
sub exists {
my ($self, $keyword) = @_;
$keyword = lc $keyword;
foreach my $ref (@{ $self->{handlers} }) {
return 1 if $ref->{name} eq $keyword;
}
foreach my $ref (@{$self->{handlers}}) { return 1 if $ref->{name} eq $keyword; }
return 0;
}
@ -105,11 +100,8 @@ sub interpreter {
} else {
if (not defined $user) {
my ($found_chan, $found_mask) = $self->{pbot}->{users}->find_user_account($cmd_channel, "$stuff->{nick}!$stuff->{user}\@$stuff->{host}", 1);
if (not defined $found_chan) {
return "/msg $stuff->{nick} You must have a user account to use $keyword.";
} else {
return "/msg $stuff->{nick} You must have a user account in $cmd_channel to use $keyword. (You have an account in $found_chan.)";
}
if (not defined $found_chan) { return "/msg $stuff->{nick} You must have a user account to use $keyword."; }
else { return "/msg $stuff->{nick} You must have a user account in $cmd_channel to use $keyword. (You have an account in $found_chan.)"; }
} elsif (not $user->{loggedin}) {
return "/msg $stuff->{nick} You must be logged into your user account to use $keyword.";
}
@ -183,11 +175,8 @@ sub help {
my $result = "/say $name: ";
$result .= "[Requires can-$keyword] " if $requires_cap;
if (not defined $help or not length $help) {
$result .= "I have no help for this command yet.";
} else {
$result .= $help;
}
if (not defined $help or not length $help) { $result .= "I have no help for this command yet."; }
else { $result .= $help; }
return $result;
}
return "$keyword is a built-in command, but I have no help for it yet.";
@ -200,15 +189,16 @@ sub help {
my @factoids = $self->{pbot}->{factoids}->find_factoid($channel_arg, $keyword, exact_trigger => 1);
if (not @factoids or not $factoids[0]) {
return "I don't know anything about $keyword.";
}
if (not @factoids or not $factoids[0]) { return "I don't know anything about $keyword."; }
my ($channel, $trigger);
if (@factoids > 1) {
if (not grep { $_->[0] eq $channel_arg } @factoids) {
return "/say $keyword found in multiple channels: " . (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids) . "; use `help $keyword <channel>` to disambiguate.";
return
"/say $keyword found in multiple channels: "
. (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids)
. "; use `help $keyword <channel>` to disambiguate.";
} else {
foreach my $factoid (@factoids) {
if ($factoid->[0] eq $channel_arg) {
@ -232,9 +222,7 @@ sub help {
my $help = $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, 'help');
if (not defined $help or not length $help) {
return "/say $trigger_name is a factoid for $channel_name, but I have no help for it yet.";
}
if (not defined $help or not length $help) { return "/say $trigger_name is a factoid for $channel_name, but I have no help for it yet."; }
$result .= $help;
return $result;
@ -254,9 +242,7 @@ sub in_channel {
my ($channel, $command) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2, 0, 1);
return $usage if not defined $channel or not defined $command;
if (not $self->{pbot}->{nicklist}->is_present($channel, $nick)) {
return "You must be present in $channel to do this.";
}
if (not $self->{pbot}->{nicklist}->is_present($channel, $nick)) { return "You must be present in $channel to do this."; }
$stuff->{from} = $channel;
$stuff->{command} = $command;

53
PBot/DualIndexHashObject.pm
View File

@ -48,7 +48,7 @@ sub load {
$self->{pbot}->{logger}->log("Loading $self->{name} from $filename ...\n");
if (not open(FILE, "< $filename")) {
Carp::carp "Skipping loading from file: Couldn't open $filename: $!\n";
$self->{pbot}->{logger}->log("Skipping loading from file: Couldn't open $filename: $!\n");
return;
}
@ -64,12 +64,9 @@ sub load {
# and lowercase any non-lowercased entries
foreach my $primary_index (keys %{$self->{hash}}) {
if (not exists $self->{hash}->{$primary_index}->{_name}) {
if (lc $primary_index eq $primary_index) {
$self->{hash}->{$primary_index}->{_name} = $primary_index;
} else {
if (exists $self->{hash}->{lc $primary_index}) {
Carp::croak "Cannot update $self->{name} primary index $primary_index; duplicate object found";
}
if (lc $primary_index eq $primary_index) { $self->{hash}->{$primary_index}->{_name} = $primary_index; }
else {
if (exists $self->{hash}->{lc $primary_index}) { Carp::croak "Cannot update $self->{name} primary index $primary_index; duplicate object found"; }
my $data = delete $self->{hash}->{$primary_index};
$data->{_name} = $primary_index;
@ -81,9 +78,8 @@ sub load {
foreach my $secondary_index (keys %{$self->{hash}->{$primary_index}}) {
next if $secondary_index eq '_name';
if (not exists $self->{hash}->{$primary_index}->{$secondary_index}->{_name}) {
if (lc $secondary_index eq $secondary_index) {
$self->{hash}->{$primary_index}->{$secondary_index}->{_name} = $secondary_index;
} else {
if (lc $secondary_index eq $secondary_index) { $self->{hash}->{$primary_index}->{$secondary_index}->{_name} = $secondary_index; }
else {
if (exists $self->{hash}->{$primary_index}->{lc $secondary_index}) {
Carp::croak "Cannot update $self->{name} $primary_index sub-object $secondary_index; duplicate object found";
}
@ -101,7 +97,8 @@ sub load {
sub save {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
if (not defined $filename) {
Carp::carp "No $self->{name} filename specified -- skipping saving to file.\n";
@ -139,19 +136,14 @@ sub levenshtein_matches {
if ($distance_result / $length < $distance) {
my $name = $self->{hash}->{$index}->{_name};
if ($name =~ / /) {
$result .= $comma . "\"$name\"";
} else {
$result .= $comma . $name;
}
if ($name =~ / /) { $result .= $comma . "\"$name\""; }
else { $result .= $comma . $name; }
$comma = ", ";
}
}
} else {
my $lc_primary_index = lc $primary_index;
if (not exists $self->{hash}->{$lc_primary_index}) {
return 'none';
}
if (not exists $self->{hash}->{$lc_primary_index}) { return 'none'; }
my $last_header = "";
my $header = "";
@ -174,11 +166,8 @@ sub levenshtein_matches {
$header = "" if $last_header eq $header;
$last_header = $header;
$comma = '; ' if $comma ne '' and $header ne '';
if ($name =~ / /) {
$result .= $comma . $header . "\"$name\"";
} else {
$result .= $comma . $header . $name;
}
if ($name =~ / /) { $result .= $comma . $header . "\"$name\""; }
else { $result .= $comma . $header . $name; }
$comma = ", ";
}
}
@ -226,9 +215,8 @@ sub set {
return $result;
}
if (not defined $value) {
$value = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key};
} else {
if (not defined $value) { $value = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key}; }
else {
$self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key} = $value;
$self->save unless $dont_save;
}
@ -361,9 +349,7 @@ sub remove {
$name2 = "\"$name2\"" if $name2 =~ / /;
# remove primary group if no more secondaries (only key left should be the _name key)
if (keys %{ $self->{hash}->{$lc_primary_index} } == 1) {
delete $self->{hash}->{$lc_primary_index};
}
if (keys %{$self->{hash}->{$lc_primary_index}} == 1) { delete $self->{hash}->{$lc_primary_index}; }
$self->save unless $dont_save;
return "$self->{name}: [$name1] $name2 removed.";
@ -373,11 +359,8 @@ sub remove {
}
my $name2 = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{_name};
if (defined delete $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$data_index}) {
return "$self->{name}: [$name1] $name2.$data_index removed.";
} else {
return "$self->{name}: [$name1] $name2.$data_index does not exist.";
}
if (defined delete $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$data_index}) { return "$self->{name}: [$name1] $name2.$data_index removed."; }
else { return "$self->{name}: [$name1] $name2.$data_index does not exist."; }
}
1;

10
PBot/EventDispatcher.pm
View File

@ -52,13 +52,12 @@ sub dispatch_event {
my $debug = $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug') // 0;
$self->{pbot}->{logger}->log("Dispatching $event_type to handler $info\n") if $debug > 1;
eval {
$ret = $handler->($event_type, $event_data);
};
eval { $ret = $handler->($event_type, $event_data); };
if ($@) {
chomp $@;
$self->{pbot}->{logger}->log("Error in event handler: $@\n");
#$self->{pbot}->{logger}->log("Removing handler.\n");
#splice @{$self->{handlers}->{$event_type}}, $i--, 1;
}
@ -71,13 +70,12 @@ sub dispatch_event {
my ($handler, $info) = ($ref->[0], $ref->[1]);
$self->{pbot}->{logger}->log("Dispatching any to handler $info\n") if $self->{pbot}->{registry}->get_value('eventdispatcher', 'debug');
eval {
$ret = $handler->($event_type, $event_data);
};
eval { $ret = $handler->($event_type, $event_data); };
if ($@) {
chomp $@;
$self->{pbot}->{logger}->log("Error in event handler: $@\n");
#$self->{pbot}->{logger}->log("Removing handler.\n");
#splice @{$self->{handlers}->{any}}, $i--, 1;
}

467
PBot/FactoidCommands.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::FactoidCommands;
use parent 'PBot::Class';
use warnings; use strict;
@ -41,6 +42,7 @@ our %factoid_metadata_capabilities = (
nooverride => 'chanop',
'cap-override' => 'botowner',
'persist-key' => 'admin',
# all others are allowed to be factset by anybody
);
@ -78,15 +80,11 @@ sub call_factoid {
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my ($chan, $keyword, $args) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 3, 0, 1);
if (not defined $chan or not defined $keyword) {
return "Usage: fact <channel> <keyword> [arguments]";
}
if (not defined $chan or not defined $keyword) { return "Usage: fact <channel> <keyword> [arguments]"; }
my ($channel, $trigger) = $self->{pbot}->{factoids}->find_factoid($chan, $keyword, arguments => $args, exact_channel => 1, exact_trigger => 1);
if (not defined $trigger) {
return "No such factoid $keyword exists for $chan";
}
if (not defined $trigger) { return "No such factoid $keyword exists for $chan"; }
$stuff->{keyword} = $trigger;
$stuff->{trigger} = $trigger;
@ -139,9 +137,7 @@ sub log_factoid {
$undos->{idx}--;
}
if ($undos->{idx} > -1 and @{$undos->{list}} > $undos->{idx} + 1) {
splice @{$undos->{list}}, $undos->{idx} + 1;
}
if ($undos->{idx} > -1 and @{$undos->{list}} > $undos->{idx} + 1) { splice @{$undos->{list}}, $undos->{idx} + 1; }
push @{$undos->{list}}, $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger);
$undos->{idx}++;
@ -170,14 +166,18 @@ sub find_factoid_with_optional_channel {
my $needs_disambig;
if (not defined $from_trigger) {
# cmd arg1, so insert $from as channel
$from_trigger = $from_chan;
$from_chan = $from;
$remaining_args = "";
#$needs_disambig = 1;
} else {
# cmd arg1 arg2 [...?]
if ($from_chan !~ /^#/ and lc $from_chan ne 'global' and $from_chan ne '.*') {
# not a channel or global, so must be a keyword
my $keyword = $from_chan;
$from_chan = $from;
@ -202,9 +202,8 @@ sub find_factoid_with_optional_channel {
my @factoids = $self->{pbot}->{factoids}->find_factoid($from_chan, $from_trigger, exact_trigger => 1);
if (not @factoids or not $factoids[0]) {
if ($needs_disambig) {
return "/say $from_trigger not found";
} else {
if ($needs_disambig) { return "/say $from_trigger not found"; }
else {
$from_chan = 'global channel' if $from_chan eq '.*';
return "/say $from_trigger not found in $from_chan";
}
@ -214,13 +213,14 @@ sub find_factoid_with_optional_channel {
if ($needs_disambig or not grep { $_->[0] eq $from_chan } @factoids) {
unless ($opts{explicit}) {
foreach my $factoid (@factoids) {
if ($factoid->[0] eq '.*') {
($channel, $trigger) = ($factoid->[0], $factoid->[1]);
}
if ($factoid->[0] eq '.*') { ($channel, $trigger) = ($factoid->[0], $factoid->[1]); }
}
}
if (not defined $channel) {
return "/say $from_trigger found in multiple channels: " . (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids) . "; use `$command <channel> $from_trigger` to disambiguate.";
return
"/say $from_trigger found in multiple channels: "
. (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids)
. "; use `$command <channel> $from_trigger` to disambiguate.";
}
} else {
foreach my $factoid (@factoids) {
@ -255,16 +255,12 @@ sub hash_differences_as_string {
foreach my $key (keys %$new) {
next if grep { $key eq $_ } @exclude;
if (not exists $old->{$key} or $old->{$key} ne $new->{$key}) {
$diff{$key} = $new->{$key};
}
if (not exists $old->{$key} or $old->{$key} ne $new->{$key}) { $diff{$key} = $new->{$key}; }
}
foreach my $key (keys %$old) {
next if grep { $key eq $_ } @exclude;
if (not exists $new->{$key}) {
$diff{"deleted $key"} = undef;
}
if (not exists $new->{$key}) { $diff{"deleted $key"} = undef; }
}
return "No change." if not keys %diff;
@ -272,14 +268,11 @@ sub hash_differences_as_string {
my $changes = "";
my $comma = "";
foreach my $key (sort keys %diff) {
if (defined $diff{$key}) {
$changes .= "$comma$key => $diff{$key}";
} else {
$changes .= "$comma$key";
}
if (defined $diff{$key}) { $changes .= "$comma$key => $diff{$key}"; }
else { $changes .= "$comma$key"; }
$comma = ", ";
}
return $changes
return $changes;
}
sub list_undo_history {
@ -290,29 +283,20 @@ sub list_undo_history {
my $result = "";
if ($start_from > @{$undos->{list}}) {
if (@{$undos->{list}} == 1) {
return "But there is only one revision available.";
} else {
return "But there are only " . @{$undos->{list}} . " revisions available.";
}
if (@{$undos->{list}} == 1) { return "But there is only one revision available."; }
else { return "But there are only " . @{$undos->{list}} . " revisions available."; }
}
if ($start_from == 0) {
if ($undos->{idx} == 0) {
$result .= "*1*: ";
} else {
$result .= "1: ";
}
if ($undos->{idx} == 0) { $result .= "*1*: "; }
else { $result .= "1: "; }
$result .= $self->hash_differences_as_string({}, $undos->{list}->[0]) . ";\n\n";
$start_from++;
}
for (my $i = $start_from; $i < @{$undos->{list}}; $i++) {
if ($i == $undos->{idx}) {
$result .= "*" . ($i + 1) . "*: ";
} else {
$result .= ($i + 1) . ": ";
}
if ($i == $undos->{idx}) { $result .= "*" . ($i + 1) . "*: "; }
else { $result .= ($i + 1) . ": "; }
$result .= $self->hash_differences_as_string($undos->{list}->[$i - 1], $undos->{list}->[$i]);
$result .= ";\n\n";
}
@ -320,6 +304,7 @@ sub list_undo_history {
}
sub factundo {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
my $usage = "Usage: factundo [-l [N]] [-r N] [channel] <keyword> (-l list undo history, optionally starting from N; -r jump to revision N)";
@ -330,9 +315,11 @@ sub factundo {
};
my ($list_undos, $goto_revision);
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
'l:i' => \$list_undos,
'r=i' => \$goto_revision);
'r=i' => \$goto_revision
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
return $usage if @$args > 2;
@ -345,6 +332,7 @@ sub factundo {
my $deleted;
if (not defined $trigger) {
# factoid not found or some error, try to continue and load undo file if it exists
$deleted = 1;
($channel, $trigger) = $self->{pbot}->{interpreter}->split_args($arglist, 2);
@ -366,12 +354,11 @@ sub factundo {
my $channel_name = $self->{pbot}->{factoids}->{factoids}->get_data($channel, '_name');
my $trigger_name = $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, '_name');
$channel_name = 'global' if $channel_name eq '.*';
$trigger_name = "\"$trigger_name\"" if $trigger_name =~ / /;
if (not $undos) {
return "There are no undos available for [$channel_name] $trigger_name.";
}
if (not $undos) { return "There are no undos available for [$channel_name] $trigger_name."; }
if (defined $list_undos) {
$list_undos = 1 if $list_undos == 0;
@ -391,16 +378,11 @@ sub factundo {
if (defined $goto_revision) {
return "Don't be absurd." if $goto_revision < 1;
if ($goto_revision > @{$undos->{list}}) {
if (@{$undos->{list}} == 1) {
return "There is only one revision available for [$channel_name] $trigger_name.";
} else {
return "There are " . @{$undos->{list}} . " revisions available for [$channel_name] $trigger_name.";
}
if (@{$undos->{list}} == 1) { return "There is only one revision available for [$channel_name] $trigger_name."; }
else { return "There are " . @{$undos->{list}} . " revisions available for [$channel_name] $trigger_name."; }
}
if ($goto_revision == $undos->{idx} + 1) {
return "[$channel_name] $trigger_name is already at revision $goto_revision.";
}
if ($goto_revision == $undos->{idx} + 1) { return "[$channel_name] $trigger_name is already at revision $goto_revision."; }
$undos->{idx} = $goto_revision - 1;
eval { store $undos, "$path/$trigger_safe.$channel_path_safe.undo"; };
@ -422,6 +404,7 @@ sub factundo {
}
sub factredo {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
@ -434,9 +417,11 @@ sub factredo {
};
my ($list_undos, $goto_revision);
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
'l:i' => \$list_undos,
'r=i' => \$goto_revision);
'r=i' => \$goto_revision
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
return $usage if @$args > 2;
@ -461,9 +446,7 @@ sub factredo {
my $path = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/factlog';
my $undos = eval { retrieve("$path/$trigger_safe.$channel_path_safe.undo"); };
if (not $undos) {
return "There are no redos available for [$channel_name] $trigger_name.";
}
if (not $undos) { return "There are no redos available for [$channel_name] $trigger_name."; }
if (defined $list_undos) {
$list_undos = 1 if $list_undos == 0;
@ -480,23 +463,16 @@ sub factredo {
}
}
if (not defined $goto_revision and $undos->{idx} + 1 == @{$undos->{list}}) {
return "There are no more redos remaining for [$channel_name] $trigger_name.";
}
if (not defined $goto_revision and $undos->{idx} + 1 == @{$undos->{list}}) { return "There are no more redos remaining for [$channel_name] $trigger_name."; }
if (defined $goto_revision) {
return "Don't be absurd." if $goto_revision < 1;
if ($goto_revision > @{$undos->{list}}) {
if (@{$undos->{list}} == 1) {
return "There is only one revision available for [$channel_name] $trigger_name.";
} else {
return "There are " . @{$undos->{list}} . " revisions available for [$channel_name] $trigger_name.";
}
if (@{$undos->{list}} == 1) { return "There is only one revision available for [$channel_name] $trigger_name."; }
else { return "There are " . @{$undos->{list}} . " revisions available for [$channel_name] $trigger_name."; }
}
if ($goto_revision == $undos->{idx} + 1) {
return "[$channel_name] $trigger_name is already at revision $goto_revision.";
}
if ($goto_revision == $undos->{idx} + 1) { return "[$channel_name] $trigger_name is already at revision $goto_revision."; }
$undos->{idx} = $goto_revision - 1;
eval { store $undos, "$path/$trigger_safe.$channel_path_safe.undo"; };
@ -518,7 +494,8 @@ sub factset {
my $self = shift;
my ($from, $nick, $user, $host, $args) = @_;
my ($channel, $trigger, $arguments) = $self->find_factoid_with_optional_channel($from, $args, 'factset', usage => 'Usage: factset [channel] <factoid> [key [value]]', explicit => 1);
my ($channel, $trigger, $arguments) =
$self->find_factoid_with_optional_channel($from, $args, 'factset', usage => 'Usage: factset [channel] <factoid> [key [value]]', explicit => 1);
return $channel if not defined $trigger; # if $trigger is not defined, $channel is an error message
my $trigger_name = $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, '_name');
@ -531,22 +508,15 @@ sub factset {
my ($owner_channel, $owner_trigger) = $self->{pbot}->{factoids}->find_factoid($channel, $trigger, exact_channel => 1, exact_trigger => 1);
my $userinfo;
if (defined $owner_channel) {
$userinfo = $self->{pbot}->{users}->loggedin($owner_channel, "$nick!$user\@$host");
} else {
$userinfo = $self->{pbot}->{users}->loggedin($channel, "$nick!$user\@$host");
}
if (defined $owner_channel) { $userinfo = $self->{pbot}->{users}->loggedin($owner_channel, "$nick!$user\@$host"); }
else { $userinfo = $self->{pbot}->{users}->loggedin($channel, "$nick!$user\@$host"); }
my $meta_cap;
if (defined $key) {
if (defined $factoid_metadata_capabilities{$key}) {
$meta_cap = $factoid_metadata_capabilities{$key};
}
if (defined $factoid_metadata_capabilities{$key}) { $meta_cap = $factoid_metadata_capabilities{$key}; }
if (defined $meta_cap) {
if (not $self->{pbot}->{capabilities}->userhas($userinfo, $meta_cap)) {
return "Your user account must have the $meta_cap capability to set $key.";
}
if (not $self->{pbot}->{capabilities}->userhas($userinfo, $meta_cap)) { return "Your user account must have the $meta_cap capability to set $key."; }
}
if (defined $value and !$self->{pbot}->{capabilities}->userhas($userinfo, 'admin') and $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, 'locked')) {
@ -554,9 +524,7 @@ sub factset {
}
if (lc $key eq 'cap-override' and defined $value) {
if (not $self->{pbot}->{capabilities}->exists($value)) {
return "No such capability $value.";
}
if (not $self->{pbot}->{capabilities}->exists($value)) { return "No such capability $value."; }
$self->{pbot}->{factoids}->{factoids}->set($channel, $trigger, 'locked', '1');
}
@ -573,10 +541,12 @@ sub factset {
my $owner;
my $mask;
if ($factoid->{'locked'}) {
# check owner against full hostmask for locked factoids
$owner = $factoid->{'owner'};
$mask = "$nick!$user\@$host";
} else {
# otherwise just the nick
($owner) = $factoid->{'owner'} =~ m/([^!]+)/;
$mask = $nick;
@ -589,9 +559,7 @@ sub factset {
my $result = $self->{pbot}->{factoids}->{factoids}->set($channel, $trigger, $key, $value);
if (defined $value and $result =~ m/set to/) {
$self->log_factoid($channel, $trigger, "$nick!$user\@$host", "set $key to $value");
}
if (defined $value and $result =~ m/set to/) { $self->log_factoid($channel, $trigger, "$nick!$user\@$host", "set $key to $value"); }
return $result;
}
@ -607,30 +575,20 @@ sub factunset {
my ($owner_channel, $owner_trigger) = $self->{pbot}->{factoids}->find_factoid($channel, $trigger, exact_channel => 1, exact_trigger => 1);
my $userinfo;
if (defined $owner_channel) {
$userinfo = $self->{pbot}->{users}->loggedin($owner_channel, "$nick!$user\@$host");
} else {
$userinfo = $self->{pbot}->{users}->loggedin($channel, "$nick!$user\@$host");
}
if (defined $owner_channel) { $userinfo = $self->{pbot}->{users}->loggedin($owner_channel, "$nick!$user\@$host"); }
else { $userinfo = $self->{pbot}->{users}->loggedin($channel, "$nick!$user\@$host"); }
my $meta_cap;
if (exists $factoid_metadata_capabilities{$key}) {
$meta_cap = $factoid_metadata_capabilities{$key};
}
if (exists $factoid_metadata_capabilities{$key}) { $meta_cap = $factoid_metadata_capabilities{$key}; }
if (defined $meta_cap) {
if (not $self->{pbot}->{capabilities}->userhas($userinfo, $meta_cap)) {
return "Your user account must have the $meta_cap capability to unset $key.";
}
if (not $self->{pbot}->{capabilities}->userhas($userinfo, $meta_cap)) { return "Your user account must have the $meta_cap capability to unset $key."; }
}
if ($self->{pbot}->{factoids}->{factoids}->exists($channel, $trigger, 'cap-override')) {
if (lc $key eq 'locked') {
if ($self->{pbot}->{capabilities}->userhas($userinfo, 'botowner')) {
$self->{pbot}->{factoids}->{factoids}->unset($channel, $trigger, 'cap-override', 1);
} else {
return "You cannot unlock this factoid because it has a cap-override. Remove the override first.";
}
if ($self->{pbot}->{capabilities}->userhas($userinfo, 'botowner')) { $self->{pbot}->{factoids}->{factoids}->unset($channel, $trigger, 'cap-override', 1); }
else { return "You cannot unlock this factoid because it has a cap-override. Remove the override first."; }
}
}
@ -651,9 +609,7 @@ sub factunset {
return "[$channel_name] $trigger_name: key '$key' does not exist." if not defined $oldvalue;
my $result = $self->{pbot}->{factoids}->{factoids}->unset($channel, $trigger, $key);
if ($result =~ m/unset/) {
$self->log_factoid($channel, $trigger, "$nick!$user\@$host", "unset $key (value: $oldvalue)");
}
if ($result =~ m/unset/) { $self->log_factoid($channel, $trigger, "$nick!$user\@$host", "unset $key (value: $oldvalue)"); }
return $result;
}
@ -665,20 +621,14 @@ sub factmove {
return $usage if not defined $target_channel;
if ($target_channel !~ /^#/ and $target_channel ne '.*') {
if (defined $target) {
return "Unexpected argument '$target' when renaming to '$target_channel'. Perhaps '$target_channel' is missing #s? $usage";
}
if (defined $target) { return "Unexpected argument '$target' when renaming to '$target_channel'. Perhaps '$target_channel' is missing #s? $usage"; }
$target = $target_channel;
$target_channel = $src_channel;
} else {
if (not defined $target) {
$target = $source;
}
if (not defined $target) { $target = $source; }
}
if (length $target > $self->{pbot}->{registry}->get_value('factoids', 'max_name_length')) {
return "/say $nick: I don't think the factoid name needs to be that long.";
}
if (length $target > $self->{pbot}->{registry}->get_value('factoids', 'max_name_length')) { return "/say $nick: I don't think the factoid name needs to be that long."; }
if (length $target_channel > $self->{pbot}->{registry}->get_value('factoids', 'max_channel_length')) {
return "/say $nick: I don't think the channel name needs to be that long.";
@ -686,9 +636,7 @@ sub factmove {
my ($found_src_channel, $found_source) = $self->{pbot}->{factoids}->find_factoid($src_channel, $source, exact_channel => 1, exact_trigger => 1);
if (not defined $found_src_channel) {
return "Source factoid $source not found in channel $src_channel";
}
if (not defined $found_src_channel) { return "Source factoid $source not found in channel $src_channel"; }
my $source_channel_name = $self->{pbot}->{factoids}->{factoids}->get_data($found_src_channel, '_name');
my $source_trigger_name = $self->{pbot}->{factoids}->{factoids}->get_data($found_src_channel, $found_source, '_name');
@ -704,9 +652,7 @@ sub factmove {
return "You are not the owner of $source_trigger_name for $source_channel_name.";
}
if ($factoids->get_data($found_src_channel, $found_source, 'locked')) {
return "/say $source_trigger_name is locked; unlock before moving.";
}
if ($factoids->get_data($found_src_channel, $found_source, 'locked')) { return "/say $source_trigger_name is locked; unlock before moving."; }
my ($found_target_channel, $found_target) = $self->{pbot}->{factoids}->find_factoid($target_channel, $target, exact_channel => 1, exact_trigger => 1);
@ -725,12 +671,12 @@ sub factmove {
$override_channel_name = 'global' if $override_channel_name eq '.*';
$override_trigger_name = "\"$override_trigger_name\"" if $override_trigger_name =~ / /;
$self->{pbot}->{logger}->log("$nick!$user\@$host attempt to override $target\n");
return "/say $override_trigger_name already exists for the global channel and cannot be overridden for " . ($target_channel eq '.*' ? 'the global channel' : $target_channel) . ".";
return
"/say $override_trigger_name already exists for the global channel and cannot be overridden for "
. ($target_channel eq '.*' ? 'the global channel' : $target_channel) . ".";
}
if ($self->{pbot}->{commands}->exists($target)) {
return "/say $target already exists as a built-in command.";
}
if ($self->{pbot}->{commands}->exists($target)) { return "/say $target already exists as a built-in command."; }
$target_channel = '.*' if $target_channel !~ /^#/;
@ -758,13 +704,11 @@ sub factalias {
my ($chan, $alias, $command) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 3, 0, 1);
if (defined $chan and not($chan eq '.*' or $chan =~ m/^#/)) {
# $chan doesn't look like a channel, so shift everything to the right
# and replace $chan with $from
if (defined $command and length $command) {
$command = "$alias $command";
} else {
$command = $alias;
}
if (defined $command and length $command) { $command = "$alias $command"; }
else { $command = $alias; }
$alias = $chan;
$chan = $from;
}
@ -772,13 +716,9 @@ sub factalias {
$chan = '.*' if $chan !~ /^#/;
return "Usage: factalias [channel] <keyword> <command>" if not length $alias or not length $command;
if (length $alias > $self->{pbot}->{registry}->get_value('factoids', 'max_name_length')) {
return "/say $nick: I don't think the factoid name needs to be that long.";
}
if (length $alias > $self->{pbot}->{registry}->get_value('factoids', 'max_name_length')) { return "/say $nick: I don't think the factoid name needs to be that long."; }
if (length $chan > $self->{pbot}->{registry}->get_value('factoids', 'max_channel_length')) {
return "/say $nick: I don't think the channel name needs to be that long.";
}
if (length $chan > $self->{pbot}->{registry}->get_value('factoids', 'max_channel_length')) { return "/say $nick: I don't think the channel name needs to be that long."; }
my ($channel, $alias_trigger) = $self->{pbot}->{factoids}->find_factoid($chan, $alias, exact_channel => 1, exact_trigger => 1);
if (defined $alias_trigger) {
@ -796,9 +736,7 @@ sub factalias {
return "/say $override_trigger_name already exists for the global channel and cannot be overridden for " . ($chan eq '.*' ? 'the global channel' : $chan) . ".";
}
if ($self->{pbot}->{commands}->exists($alias)) {
return "/say $alias already exists as a built-in command.";
}
if ($self->{pbot}->{commands}->exists($alias)) { return "/say $alias already exists as a built-in command."; }
$self->{pbot}->{factoids}->add_factoid('text', $chan, "$nick!$user\@$host", $alias, "/call $command");
$self->{pbot}->{logger}->log("$nick!$user\@$host [$chan] aliased $alias => $command\n");
@ -817,16 +755,12 @@ sub add_regex {
if (not defined $keyword) {
$text = "";
foreach my $trigger (sort $factoids->get_keys($from)) {
if ($factoids->get_data($from, $trigger, 'type') eq 'regex') {
$text .= $trigger . " ";
}
if ($factoids->get_data($from, $trigger, 'type') eq 'regex') { $text .= $trigger . " "; }
}
return "Stored regexs for channel $from: $text";
}
if (not defined $text) {
return "Usage: regex <regex> <command>";
}
if (not defined $text) { return "Usage: regex <regex> <command>"; }
my ($channel, $trigger) = $self->{pbot}->{factoids}->find_factoid($from, $keyword, exact_channel => 1, exact_trigger => 1);
@ -848,6 +782,7 @@ sub factadd {
my @arglist = @{$stuff->{arglist}};
if (@arglist) {
# check for -f since we allow it to be before optional channel argument
if ($arglist[0] eq '-f') {
$force = 1;
@ -855,11 +790,8 @@ sub factadd {
}
# check if this is an optional channel argument
if ($arglist[0] =~ m/(?:^#|^global$|^\.\*$)/i) {
$from_chan = $self->{pbot}->{interpreter}->shift_arg(\@arglist);
} else {
$from_chan = $from;
}
if ($arglist[0] =~ m/(?:^#|^global$|^\.\*$)/i) { $from_chan = $self->{pbot}->{interpreter}->shift_arg(\@arglist); }
else { $from_chan = $from; }
# check for -f again since we also allow it to appear after the channel argument
if ($arglist[0] eq '-f') {
@ -872,6 +804,7 @@ sub factadd {
# check for -url
if ($arglist[0] eq '-url') {
# discard it
$self->{pbot}->{interpreter}->shift_arg(\@arglist);
@ -879,9 +812,7 @@ sub factadd {
my ($url) = $self->{pbot}->{interpreter}->split_args(\@arglist, 1);
# FIXME: move this to registry
if ($url !~ m/^https?:\/\/(?:sprunge.us|ix.io)\/\w+$/) {
return "Invalid URL: acceptable URLs are: http://sprunge.us, http://ix.io";
}
if ($url !~ m/^https?:\/\/(?:sprunge.us|ix.io)\/\w+$/) { return "Invalid URL: acceptable URLs are: http://sprunge.us, http://ix.io"; }
# create a UserAgent
my $ua = LWP::UserAgent->new(timeout => 10);
@ -890,16 +821,12 @@ sub factadd {
my $response = $ua->get($url);
# process the response
if ($response->is_success) {
$text = $response->decoded_content;
} else {
return "Failed to get URL: " . $response->status_line;
}
if ($response->is_success) { $text = $response->decoded_content; }
else { return "Failed to get URL: " . $response->status_line; }
} else {
# check for optional "is" and discard
if (lc $arglist[0] eq 'is') {
$self->{pbot}->{interpreter}->shift_arg(\@arglist);
}
if (lc $arglist[0] eq 'is') { $self->{pbot}->{interpreter}->shift_arg(\@arglist); }
# and the text is the remaining arguments with quotes preserved
($text) = $self->{pbot}->{interpreter}->split_args(\@arglist, 1, 0, 1);
@ -912,13 +839,9 @@ sub factadd {
$from_chan = '.*' if $from_chan !~ /^#/;
if (length $keyword > $self->{pbot}->{registry}->get_value('factoids', 'max_name_length')) {
return "/say $nick: I don't think the factoid name needs to be that long.";
}
if (length $keyword > $self->{pbot}->{registry}->get_value('factoids', 'max_name_length')) { return "/say $nick: I don't think the factoid name needs to be that long."; }
if (length $from_chan > $self->{pbot}->{registry}->get_value('factoids', 'max_channel_length')) {
return "/say $nick: I don't think the channel needs to be that long.";
}
if (length $from_chan > $self->{pbot}->{registry}->get_value('factoids', 'max_channel_length')) { return "/say $nick: I don't think the channel needs to be that long."; }
$from_chan = '.*' if lc $from_chan eq 'global';
$from_chan = '.*' if not $from_chan =~ m/^#/;
@ -932,14 +855,11 @@ sub factadd {
$channel_name = 'global' if $channel_name eq '.*';
$trigger_name = "\"$trigger_name\"" if $trigger_name =~ / /;
if (not $force) {
return "/say $trigger_name already exists for $channel_name.";
} else {
if (not $force) { return "/say $trigger_name already exists for $channel_name."; }
else {
my $factoids = $self->{pbot}->{factoids}->{factoids};
if ($factoids->get_data($channel, $trigger, 'locked')) {
return "/say $trigger_name is locked; unlock before overwriting.";
}
if ($factoids->get_data($channel, $trigger, 'locked')) { return "/say $trigger_name is locked; unlock before overwriting."; }
my ($owner) = $factoids->get_data($channel, $trigger, 'owner') =~ m/([^!]+)/;
if ((lc $nick ne lc $owner) and (not $self->{pbot}->{users}->loggedin_admin($channel, "$nick!$user\@$host"))) {
@ -955,9 +875,7 @@ sub factadd {
return "/say $trigger_name already exists for the global channel and cannot be overridden for " . ($from_chan eq '.*' ? 'the global channel' : $from_chan) . ".";
}
if ($self->{pbot}->{commands}->exists($keyword)) {
return "/say $keyword_text already exists as a built-in command.";
}
if ($self->{pbot}->{commands}->exists($keyword)) { return "/say $keyword_text already exists as a built-in command."; }
$self->{pbot}->{factoids}->add_factoid('text', $from_chan, "$nick!$user\@$host", $keyword, $text);
$self->{pbot}->{logger}->log("$nick!$user\@$host added [$from_chan] $keyword_text => $text\n");
@ -987,9 +905,7 @@ sub factrem {
$channel_name = 'global' if $channel_name eq '.*';
$trigger_name = "\"$trigger_name\"" if $trigger_name =~ / /;
if ($factoids->get_data($channel, $trigger, 'type') eq 'module') {
return "/say $trigger_name is not a factoid.";
}
if ($factoids->get_data($channel, $trigger, 'type') eq 'module') { return "/say $trigger_name is not a factoid."; }
if ($channel =~ /^#/ and $from_chan =~ /^#/ and $channel ne $from_chan) {
return "/say $trigger_name belongs to $channel_name, but this is $from_chan. Please switch to $channel_name or use /msg to remove this factoid.";
@ -1001,9 +917,7 @@ sub factrem {
return "You are not the owner of $trigger_name for $channel_name.";
}
if ($factoids->get_data($channel, $trigger, 'locked')) {
return "/say $trigger_name is locked; unlock before deleting.";
}
if ($factoids->get_data($channel, $trigger, 'locked')) { return "/say $trigger_name is locked; unlock before deleting."; }
$self->{pbot}->{logger}->log("$nick!$user\@$host removed [$channel][$trigger][" . $factoids->get_data($channel, $trigger, 'action') . "]\n");
$self->{pbot}->{factoids}->remove_factoid($channel, $trigger);
@ -1012,6 +926,7 @@ sub factrem {
}
sub histogram {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->{factoids}->{factoids};
@ -1053,8 +968,10 @@ sub factshow {
};
my ($paste);
my ($ret, $args) = GetOptionsFromString($arguments,
'p' => \$paste);
my ($ret, $args) = GetOptionsFromString(
$arguments,
'p' => \$paste
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
return "Too many arguments -- $usage" if @$args > 2;
@ -1101,9 +1018,11 @@ sub factlog {
};
my ($show_hostmask, $actual_timestamp);
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
'h' => \$show_hostmask,
't' => \$actual_timestamp);
't' => \$actual_timestamp
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
return "Too many arguments -- $usage" if @$args > 2;
@ -1114,6 +1033,7 @@ sub factlog {
my ($channel, $trigger) = $self->find_factoid_with_optional_channel($from, $args, 'factlog', usage => $usage, exact_channel => 1);
if (not defined $trigger) {
# factoid not found or some error, try to continue and load factlog file if it exists
my $arglist = $self->{pbot}->{interpreter}->make_args($args);
($channel, $trigger) = $self->{pbot}->{interpreter}->split_args($arglist, 2);
@ -1149,11 +1069,8 @@ sub factlog {
($timestamp, $hostmask, $msg) = split /\s+/, $line, 3 if $@;
$hostmask =~ s/!.*$// if not $show_hostmask;
if ($actual_timestamp) {
$timestamp = strftime "%a %b %e %H:%M:%S %Z %Y", localtime $timestamp;
} else {
$timestamp = concise ago gettimeofday - $timestamp;
}
if ($actual_timestamp) { $timestamp = strftime "%a %b %e %H:%M:%S %Z %Y", localtime $timestamp; }
else { $timestamp = concise ago gettimeofday - $timestamp; }
push @entries, "[$timestamp] $hostmask $msg\n";
}
close $fh;
@ -1185,26 +1102,78 @@ sub factinfo {
# factoid
if ($factoids->get_data($channel, $trigger, 'type') eq 'text') {
return "/say $trigger_name: Factoid submitted by " . $factoids->get_data($channel, $trigger, 'owner') . " for $channel_name on " . localtime($factoids->get_data($channel, $trigger, 'created_on')) . " [$created_ago], " . (defined $factoids->get_data($channel, $trigger, 'edited_by') ? 'last edited by ' . $factoids->get_data($channel, $trigger, 'edited_by') . ' on ' . localtime($factoids->get_data($channel, $trigger, 'edited_on')) . " [" . ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], " : "") . "referenced " . $factoids->get_data($channel, $trigger, 'ref_count') . ' times (last by ' . $factoids->get_data($channel, $trigger, 'ref_user') . ($factoids->exists($channel, $trigger, 'last_referenced_on') ? ' on ' . localtime($factoids->get_data($channel, $trigger, 'last_referenced_on')) . " [$ref_ago]" : '') . ')';
return
"/say $trigger_name: Factoid submitted by "
. $factoids->get_data($channel, $trigger, 'owner')
. " for $channel_name on "
. localtime($factoids->get_data($channel, $trigger, 'created_on'))
. " [$created_ago], "
. (
defined $factoids->get_data($channel, $trigger, 'edited_by')
? 'last edited by '
. $factoids->get_data($channel, $trigger, 'edited_by') . ' on '
. localtime($factoids->get_data($channel, $trigger, 'edited_on')) . " ["
. ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], "
: ""
)
. "referenced "
. $factoids->get_data($channel, $trigger, 'ref_count')
. ' times (last by '
. $factoids->get_data($channel, $trigger, 'ref_user')
. ($factoids->exists($channel, $trigger, 'last_referenced_on') ? ' on ' . localtime($factoids->get_data($channel, $trigger, 'last_referenced_on')) . " [$ref_ago]" : '')
. ')';
}
# module
if ($factoids->get_data($channel, $trigger, 'type') eq 'module') {
my $module_repo = $self->{pbot}->{registry}->get_value('general', 'module_repo');
$module_repo .= $factoids->get_data($channel, $trigger, 'workdir') . '/' if $factoids->exists($channel, $trigger, 'workdir');
return "/say $trigger_name: Module loaded by " . $factoids->get_data($channel, $trigger, 'owner') . " for $channel_name on " . localtime($factoids->get_data($channel, $trigger, 'created_on')) . " [$created_ago] -> $module_repo" . $factoids->get_data($channel, $trigger, 'action') . ', used ' . $factoids->get_data($channel, $trigger, 'ref_count') . ' times (last by ' . $factoids->get_data($channel, $trigger, 'ref_user') . ($factoids->exists($channel, $trigger, 'last_referenced_on') ? ' on ' . localtime($factoids->get_data($channel, $trigger, 'last_referenced_on')) . " [$ref_ago]" : '') . ')';
return
"/say $trigger_name: Module loaded by "
. $factoids->get_data($channel, $trigger, 'owner')
. " for $channel_name on "
. localtime($factoids->get_data($channel, $trigger, 'created_on'))
. " [$created_ago] -> $module_repo"
. $factoids->get_data($channel, $trigger, 'action')
. ', used '
. $factoids->get_data($channel, $trigger, 'ref_count')
. ' times (last by '
. $factoids->get_data($channel, $trigger, 'ref_user')
. ($factoids->exists($channel, $trigger, 'last_referenced_on') ? ' on ' . localtime($factoids->get_data($channel, $trigger, 'last_referenced_on')) . " [$ref_ago]" : '')
. ')';
}
# regex
if ($factoids->get_data($channel, $trigger, 'type') eq 'regex') {
return "/say $trigger_name: Regex created by " . $factoids->get_data($channel, $trigger, 'owner') . " for $channel_name on " . localtime($factoids->get_data($channel, $trigger, 'created_on')) . " [$created_ago], " . (defined $factoids->get_data($channel, $trigger, 'edited_by') ? 'last edited by ' . $factoids->get_data($channel, $trigger, 'edited_by') . ' on ' . localtime($factoids->get_data($channel, $trigger, 'edited_on')) . " [" . ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], " : "") . ' used ' . $factoids->get_data($channel, $trigger, 'ref_count') . ' times (last by ' . $factoids->get_data($channel, $trigger, 'ref_user') . ($factoids->exists($channel, $trigger, 'last_referenced_on') ? ' on ' . localtime($factoids->get_data($channel, $trigger, 'last_referenced_on')) . " [$ref_ago]" : '') . ')';
return
"/say $trigger_name: Regex created by "
. $factoids->get_data($channel, $trigger, 'owner')
. " for $channel_name on "
. localtime($factoids->get_data($channel, $trigger, 'created_on'))
. " [$created_ago], "
. (
defined $factoids->get_data($channel, $trigger, 'edited_by')
? 'last edited by '
. $factoids->get_data($channel, $trigger, 'edited_by') . ' on '
. localtime($factoids->get_data($channel, $trigger, 'edited_on')) . " ["
. ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], "
: ""
)
. ' used '
. $factoids->get_data($channel, $trigger, 'ref_count')
. ' times (last by '
. $factoids->get_data($channel, $trigger, 'ref_user')
. ($factoids->exists($channel, $trigger, 'last_referenced_on') ? ' on ' . localtime($factoids->get_data($channel, $trigger, 'last_referenced_on')) . " [$ref_ago]" : '')
. ')';
}
return "/say $arguments is not a factoid or a module.";
}
sub top20 {
my $self = shift;
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my $factoids = $self->{pbot}->{factoids}->{factoids};
my %hash = ();
@ -1213,9 +1182,7 @@ sub top20 {
my ($channel, $args) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
if (not defined $channel) {
return "Usage: top20 <channel> [nick or 'recent']";
}
if (not defined $channel) { return "Usage: top20 <channel> [nick or 'recent']"; }
if (not defined $args) {
foreach my $chan (sort $factoids->get_keys) {
@ -1252,13 +1219,13 @@ sub top20 {
my $user = lc $args;
foreach my $chan (sort $factoids->get_keys) {
next if lc $chan ne lc $channel;
foreach my $command (sort { ($factoids->get_data($chan, $b, 'last_referenced_on') || 0) <=> ($factoids->get_data($chan, $a, 'last_referenced_on') || 0) } $factoids->get_keys($chan)) {
foreach my $command (sort { ($factoids->get_data($chan, $b, 'last_referenced_on') || 0) <=> ($factoids->get_data($chan, $a, 'last_referenced_on') || 0) }
$factoids->get_keys($chan))
{
next if $command eq '_name';
my $ref_user = lc $factoids->get_data($chan, $command, 'ref_user');
if ($ref_user =~ /\Q$args\E/i) {
if ($user ne $ref_user && not $user =~ /$ref_user/i) {
$user .= " ($ref_user)";
}
if ($user ne $ref_user && not $user =~ /$ref_user/i) { $user .= " ($ref_user)"; }
my $ago = $factoids->get_data($chan, $command, 'last_referenced_on') ? concise ago(gettimeofday - $factoids->get_data($chan, $command, 'last_referenced_on')) : "unknown";
$text .= ' ' . $factoids->get_data($chan, $command, '_name') . " [$ago]\n";
$i++;
@ -1272,15 +1239,14 @@ sub top20 {
}
sub count {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $factoids = $self->{pbot}->{factoids}->{factoids};
my $i = 0;
my $total = 0;
if (not length $arguments) {
return "Usage: count <nick|factoids>";
}
if (not length $arguments) { return "Usage: count <nick|factoids>"; }
$arguments = ".*" if ($arguments =~ /^factoids$/);
@ -1290,9 +1256,7 @@ sub count {
next if $command eq '_name';
next if $factoids->get_data($channel, $command, 'type') ne 'text';
$total++;
if ($factoids->get_data($channel, $command, 'owner') =~ /^\Q$arguments\E$/i) {
$i++;
}
if ($factoids->get_data($channel, $command, 'owner') =~ /^\Q$arguments\E$/i) { $i++; }
}
}
};
@ -1338,35 +1302,24 @@ sub factfind {
$argtype = "owned by $owner" if $owner ne '.*';
if ($refby ne '.*') {
if (not defined $argtype) {
$argtype = "last referenced by $refby";
} else {
$argtype .= " and last referenced by $refby";
}
if (not defined $argtype) { $argtype = "last referenced by $refby"; }
else { $argtype .= " and last referenced by $refby"; }
}
if ($editby ne '.*') {
if (not defined $argtype) {
$argtype = "last edited by $editby";
} else {
$argtype .= " and last edited by $editby";
}
if (not defined $argtype) { $argtype = "last edited by $editby"; }
else { $argtype .= " and last edited by $editby"; }
}
if ($arguments ne "") {
my $unquoted_args = $arguments;
$unquoted_args =~ s/(?:\\(?!\\))//g;
$unquoted_args =~ s/(?:\\\\)/\\/g;
if (not defined $argtype) {
$argtype = "with text containing '$unquoted_args'";
} else {
$argtype .= " and with text containing '$unquoted_args'";
}
if (not defined $argtype) { $argtype = "with text containing '$unquoted_args'"; }
else { $argtype .= " and with text containing '$unquoted_args'"; }
}
if (not defined $argtype) {
return $usage;
}
if (not defined $argtype) { return $usage; }
my ($text, $last_trigger, $last_chan, $i);
$last_chan = "";
@ -1374,9 +1327,8 @@ sub factfind {
eval {
use re::engine::RE2 -strict => 1;
my $regex;
if ($use_regex) {
$regex = $arguments;
} else {
if ($use_regex) { $regex = $arguments; }
else {
$regex = ($arguments =~ m/^\w/) ? '\b' : '\B';
$regex .= quotemeta $arguments;
$regex .= ($arguments =~ m/\w$/) ? '\b' : '\B';
@ -1389,7 +1341,8 @@ sub factfind {
if ($factoids->get_data($chan, $trigger, 'type') eq 'text' or $factoids->get_data($chan, $trigger, 'type') eq 'regex') {
if ( $factoids->get_data($chan, $trigger, 'owner') =~ /^$owner$/i
&& $factoids->get_data($chan, $trigger, 'ref_user') =~ /^$refby$/i
&& ($factoids->exists($chan, $trigger, 'edited_by') ? $factoids->get_data($chan, $trigger, 'edited_by') =~ /^$editby$/i : 1)) {
&& ($factoids->exists($chan, $trigger, 'edited_by') ? $factoids->get_data($chan, $trigger, 'edited_by') =~ /^$editby$/i : 1))
{
next if ($arguments ne "" && $factoids->get_data($chan, $trigger, 'action') !~ /$regex/i && $trigger !~ /$regex/i);
$i++;
if ($chan ne $last_chan) {
@ -1410,7 +1363,12 @@ sub factfind {
if ($i == 1) {
chop $text;
return "Found one factoid submitted for " . ($last_chan eq '.*' ? 'global channel' : $factoids->get_data($last_chan, '_name')) . ' ' . $argtype . ": $last_trigger is " . $factoids->get_data($last_chan, $last_trigger, 'action');
return
"Found one factoid submitted for "
. ($last_chan eq '.*' ? 'global channel' : $factoids->get_data($last_chan, '_name')) . ' '
. $argtype
. ": $last_trigger is "
. $factoids->get_data($last_chan, $last_trigger, 'action');
} else {
return "Found $i factoids " . $argtype . ": $text" unless $i == 0;
my $chans = (defined $channel ? ($channel eq '.*' ? 'global channel' : $channel) : 'any channels');
@ -1487,7 +1445,10 @@ sub factchange {
if (@factoids > 1) {
if (not grep { $_->[0] eq $from_chan } @factoids) {
return "/say $from_trigger found in multiple channels: " . (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids) . "; use `factchange <channel> $from_trigger` to disambiguate.";
return
"/say $from_trigger found in multiple channels: "
. (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids)
. "; use `factchange <channel> $from_trigger` to disambiguate.";
} else {
foreach my $factoid (@factoids) {
if ($factoid->[0] eq $from_chan) {
@ -1500,9 +1461,7 @@ sub factchange {
($channel, $trigger) = ($factoids[0]->[0], $factoids[0]->[1]);
}
if (not defined $trigger) {
return "/say $keyword not found in channel $from_chan.";
}
if (not defined $trigger) { return "/say $keyword not found in channel $from_chan."; }
my $channel_name = $self->{pbot}->{factoids}->{factoids}->get_data($channel, '_name');
my $trigger_name = $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, '_name');
@ -1527,19 +1486,15 @@ sub factchange {
my $action = $factoids_data->get_data($channel, $trigger, 'action');
if (defined $url) {
# FIXME: move this to registry
if ($url !~ m/^https?:\/\/(?:sprunge.us|ix.io)\/\w+$/) {
return "Invalid URL: acceptable URLs are: http://sprunge.us, http://ix.io";
}
if ($url !~ m/^https?:\/\/(?:sprunge.us|ix.io)\/\w+$/) { return "Invalid URL: acceptable URLs are: http://sprunge.us, http://ix.io"; }
my $ua = LWP::UserAgent->new(timeout => 10);
my $response = $ua->get($url);
if ($response->is_success) {
$action = $response->decoded_content;
} else {
return "Failed to get URL: " . $response->status_line;
}
if ($response->is_success) { $action = $response->decoded_content; }
else { return "Failed to get URL: " . $response->status_line; }
} else {
my $ret = eval {
use re::engine::RE2 -strict => 1;
@ -1555,17 +1510,11 @@ sub factchange {
while (1) {
if ($count == 0) {
if ($insensitive) {
$changed = $action =~ s|$tochange|$changeto$magic|i;
if ($insensitive) { $changed = $action =~ s|$tochange|$changeto$magic|i; }
else { $changed = $action =~ s|$tochange|$changeto$magic|; }
} else {
$changed = $action =~ s|$tochange|$changeto$magic|;
}
} else {
if ($insensitive) {
$changed = $action =~ s|$tochange|$1$changeto$magic|i;
} else {
$changed = $action =~ s|$tochange|$1$changeto$magic|;
}
if ($insensitive) { $changed = $action =~ s|$tochange|$1$changeto$magic|i; }
else { $changed = $action =~ s|$tochange|$1$changeto$magic|; }
}
if ($changed) {
@ -1602,13 +1551,9 @@ sub factchange {
return $ret if length $ret;
}
if (length $action > 8000 and not $self->{pbot}->{capabilities}->userhas($userinfo, 'admin')) {
return "Change $trigger_name failed; result is too long.";
}
if (length $action > 8000 and not $self->{pbot}->{capabilities}->userhas($userinfo, 'admin')) { return "Change $trigger_name failed; result is too long."; }
if (not length $action) {
return "Change $trigger_name failed; factoids cannot be empty.";
}
if (not length $action) { return "Change $trigger_name failed; factoids cannot be empty."; }
$self->{pbot}->{logger}->log("($from) $nick!$user\@$host: changed '$trigger' 's/$tochange/$changeto/\n");

239
PBot/Factoids.pm
View File

@ -86,6 +86,7 @@ sub add_factoid {
my $data;
if ($self->{factoids}->exists($channel, $trigger)) {
# only update action field if force-adding it through factadd -f
$data = $self->{factoids}->get_data($channel, $trigger);
$data->{action} = $action;
@ -118,7 +119,8 @@ sub export_factoids {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/factoids.html'; }
if (@_) { $filename = shift; }
else { $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/factoids.html'; }
return if not defined $filename;
open FILE, "> $filename" or return "Could not open export path.";
@ -166,11 +168,8 @@ sub export_factoids {
my $trigger_name = $self->{factoids}->get_data($channel, $trigger, '_name');
if ($self->{factoids}->get_data($channel, $trigger, 'type') eq 'text') {
$i++;
if ($i % 2) {
print FILE "<tr bgcolor=\"#dddddd\">\n";
} else {
print FILE "<tr>\n";
}
if ($i % 2) { print FILE "<tr bgcolor=\"#dddddd\">\n"; }
else { print FILE "<tr>\n"; }
print FILE "<td>" . encode_entities($self->{factoids}->get_data($channel, $trigger, 'owner')) . "</td>\n";
print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->get_data($channel, $trigger, 'created_on')) . "</td>\n";
@ -270,14 +269,12 @@ sub find_factoid {
for (my $depth = 0; $depth < 5; $depth++) {
my $string = $keyword . (length $arguments ? " $arguments" : "");
$self->{pbot}->{logger}->log("string: $string\n") if $debug;
# check factoids
foreach my $channel (sort $self->{factoids}->get_keys) {
if ($opts{exact_channel}) {
if ($opts{exact_trigger} == 1) {
next unless $from eq lc $channel;
} else {
next unless $from eq lc $channel or $channel eq '.*';
}
if ($opts{exact_trigger} == 1) { next unless $from eq lc $channel; }
else { next unless $from eq lc $channel or $channel eq '.*'; }
}
foreach my $trigger ($self->{factoids}->get_keys($channel)) {
@ -286,21 +283,15 @@ sub find_factoid {
if ($opts{find_alias} && $self->{factoids}->get_data($channel, $trigger, 'action') =~ /^\/call\s+(.*)$/ms) {
my $command;
if (length $arguments) {
$command = "$1 $arguments";
} else {
$command = $1;
}
if (length $arguments) { $command = "$1 $arguments"; }
else { $command = $1; }
my $arglist = $self->{pbot}->{interpreter}->make_args($command);
($keyword, $arguments) = $self->{pbot}->{interpreter}->split_args($arglist, 2, 0, 1);
goto NEXT_DEPTH;
}
if ($opts{exact_channel} == 1) {
return ($channel, $trigger);
} else {
push @results, [$channel, $trigger];
}
if ($opts{exact_channel} == 1) { return ($channel, $trigger); }
else { push @results, [$channel, $trigger]; }
}
}
}
@ -308,9 +299,7 @@ sub find_factoid {
# then check regex factoids
if (not $opts{exact_trigger}) {
foreach my $channel ($self->{factoids}->get_keys) {
if ($opts{exact_channel}) {
next unless $from eq lc $channel or $channel eq '.*';
}
if ($opts{exact_channel}) { next unless $from eq lc $channel or $channel eq '.*'; }
foreach my $trigger (sort $self->{factoids}->get_keys($channel)) {
next if $trigger eq '_name';
@ -327,11 +316,8 @@ sub find_factoid {
goto NEXT_DEPTH;
}
if ($opts{exact_channel} == 1) {
return ($channel, $trigger);
} else {
push @results, [$channel, $trigger];
}
if ($opts{exact_channel} == 1) { return ($channel, $trigger); }
else { push @results, [$channel, $trigger]; }
}
}
}
@ -343,9 +329,8 @@ sub find_factoid {
}
if ($debug) {
if (not @results) {
$self->{pbot}->{logger}->log("find_factoid: no match\n");
} else {
if (not @results) { $self->{pbot}->{logger}->log("find_factoid: no match\n"); }
else {
$self->{pbot}->{logger}->log("find_factoid: got results: " . (join ', ', map { "$_->[0] -> $_->[1]" } @results) . "\n");
}
}
@ -374,7 +359,8 @@ sub expand_special_vars {
$action =~ s/\$nick:json|\$\{nick:json\}/$self->escape_json($nick)/ge;
$action =~ s/\$channel:json|\$\{channel:json\}/$self->escape_json($from)/ge;
$action =~ s/\$randomnick:json|\$\{randomnick:json\}/my $random = $self->{pbot}->{nicklist}->random_nick($from); $random ? $self->escape_json($random) : $self->escape_json($nick)/ge;
$action =~
s/\$randomnick:json|\$\{randomnick:json\}/my $random = $self->{pbot}->{nicklist}->random_nick($from); $random ? $self->escape_json($random) : $self->escape_json($nick)/ge;
$action =~ s/\$0:json|\$\{0:json\}/$self->escape_json($root_keyword)/ge;
$action =~ s/\$nick|\$\{nick\}/$nick/g;
@ -386,6 +372,7 @@ sub expand_special_vars {
}
sub expand_factoid_vars {
my ($self, $stuff, @exclude) = @_;
my $from = length $stuff->{ref_from} ? $stuff->{ref_from} : $stuff->{from};
@ -402,9 +389,7 @@ sub expand_factoid_vars {
$self->{pbot}->{logger}->log(Dumper $stuff);
}
if ($action =~ m/^\/call --keyword-override=([^ ]+)/i) {
$root_keyword = $1;
}
if ($action =~ m/^\/call --keyword-override=([^ ]+)/i) { $root_keyword = $1; }
while (1) {
last if ++$depth >= 1000;
@ -438,9 +423,7 @@ sub expand_factoid_vars {
$test_v =~ s/\{(.+)\}/$1/;
my $modifier = '';
if ($test_v =~ s/(:.*)$//) {
$modifier = $1;
}
if ($test_v =~ s/(:.*)$//) { $modifier = $1; }
if ($modifier =~ m/^:(#[^:]+|global)/i) {
$from = $1;
@ -464,13 +447,9 @@ sub expand_factoid_vars {
my $change = $self->{factoids}->get_data($var_chan, $var, 'action');
my @list = $self->{pbot}->{interpreter}->split_line($change);
my @mylist;
for (my $i = 0; $i <= $#list; $i++) {
push @mylist, $list[$i] if defined $list[$i] and length $list[$i];
}
for (my $i = 0; $i <= $#list; $i++) { push @mylist, $list[$i] if defined $list[$i] and length $list[$i]; }
my $line = int(rand($#mylist + 1));
if (not $mylist[$line] =~ s/^"(.*)"$/$1/) {
$mylist[$line] =~ s/^'(.*)'$/$1/;
}
if (not $mylist[$line] =~ s/^"(.*)"$/$1/) { $mylist[$line] =~ s/^'(.*)'$/$1/; }
foreach my $mod (split /:/, $modifier) {
next if not length $mod;
@ -490,22 +469,14 @@ sub expand_factoid_vars {
}
given ($mod) {
when ('uc') {
$mylist[$line] = uc $mylist[$line];
}
when ('lc') {
$mylist[$line] = lc $mylist[$line];
}
when ('ucfirst') {
$mylist[$line] = ucfirst $mylist[$line];
}
when ('uc') { $mylist[$line] = uc $mylist[$line]; }
when ('lc') { $mylist[$line] = lc $mylist[$line]; }
when ('ucfirst') { $mylist[$line] = ucfirst $mylist[$line]; }
when ('title') {
$mylist[$line] = ucfirst lc $mylist[$line];
$mylist[$line] =~ s/ (\w)/' ' . uc $1/ge;
}
when ('json') {
$mylist[$line] = $self->escape_json($mylist[$line]);
}
when ('json') { $mylist[$line] = $self->escape_json($mylist[$line]); }
}
}
@ -517,9 +488,7 @@ sub expand_factoid_vars {
$replacement = "$fixed_a $mylist[$line]";
}
if ($debug and $offset == 0) {
$self->{pbot}->{logger}->log(("-" x 40) . "\n");
}
if ($debug and $offset == 0) { $self->{pbot}->{logger}->log(("-" x 40) . "\n"); }
$original_v = quotemeta $original_v;
$original_v =~ s/\\:/:/g;
@ -564,9 +533,7 @@ sub expand_factoid_vars {
$action =~ s/\\\$/\$/g;
unless (@exclude) {
$action = $self->expand_special_vars($from, $nick, $root_keyword, $action);
}
unless (@exclude) { $action = $self->expand_special_vars($from, $nick, $root_keyword, $action); }
return validate_string($action, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length'));
}
@ -578,11 +545,8 @@ sub expand_action_arguments {
$input = validate_string($input, $self->{pbot}->{registry}->get_value('factoids', 'max_content_length'));
my %h;
if (not defined $input or $input eq '') {
%h = (args => $nick);
} else {
%h = (args => $input);
}
if (not defined $input or $input eq '') { %h = (args => $nick); }
else { %h = (args => $input); }
my $jsonargs = encode_json \%h;
$jsonargs =~ s/^{".*":"//;
@ -608,11 +572,8 @@ sub expand_action_arguments {
last if ++$depth >= 100;
if ($arg eq '*') {
if (not defined $input or $input eq '') {
$action =~ s/\$arg\[\*\]|\$\{arg\[\*\]\}/$nick/;
} else {
$action =~ s/\$arg\[\*\]|\$\{arg\[\*\]\}/$input/;
}
if (not defined $input or $input eq '') { $action =~ s/\$arg\[\*\]|\$\{arg\[\*\]\}/$nick/; }
else { $action =~ s/\$arg\[\*\]|\$\{arg\[\*\]\}/$input/; }
next;
}
@ -632,16 +593,12 @@ sub expand_action_arguments {
return @args[$arg1i .. $arg2i];
};
if ($@) {
next;
} else {
if ($@) { next; }
else {
my $string = join(' ', @values);
if ($string eq '') {
$action =~ s/\s*\$\{arg\[$arg1:$arg2\]\}// || $action =~ s/\s*\$arg\[$arg1:$arg2\]//;
} else {
$action =~ s/\$\{arg\[$arg1:$arg2\]\}/$string/ || $action =~ s/\$arg\[$arg1:$arg2\]/$string/;
}
if ($string eq '') { $action =~ s/\s*\$\{arg\[$arg1:$arg2\]\}// || $action =~ s/\s*\$arg\[$arg1:$arg2\]//; }
else { $action =~ s/\$\{arg\[$arg1:$arg2\]\}/$string/ || $action =~ s/\$arg\[$arg1:$arg2\]/$string/; }
}
next;
@ -652,16 +609,12 @@ sub expand_action_arguments {
return $args[$arg];
};
if ($@) {
next;
} else {
if ($@) { next; }
else {
if (not defined $value) {
if ($arg == 0) {
$action =~ s/\$\{arg\[$arg\]\}/$nick/ || $action =~ s/\$arg\[$arg\]/$nick/;
} else {
$action =~ s/\s*\$\{arg\[$arg\]\}// || $action =~ s/\s*\$arg\[$arg\]//;
}
if ($arg == 0) { $action =~ s/\$\{arg\[$arg\]\}/$nick/ || $action =~ s/\$arg\[$arg\]/$nick/; }
else { $action =~ s/\s*\$\{arg\[$arg\]\}// || $action =~ s/\s*\$arg\[$arg\]//; }
} else {
$action =~ s/\$arg\{\[$arg\]\}/$value/ || $action =~ s/\$arg\[$arg\]/$value/;
}
@ -674,12 +627,11 @@ sub expand_action_arguments {
sub execute_code_factoid_using_vm {
my ($self, $stuff) = @_;
unless ($self->{factoids}->exists($stuff->{channel}, $stuff->{keyword}, 'interpolate') and $self->{factoids}->get_data($stuff->{channel}, $stuff->{keyword}, 'interpolate') eq '0') {
if ($stuff->{code} =~ m/(?:\$\{?nick\b|\$\{?args\b|\$\{?arg\[)/ and length $stuff->{arguments}) {
$stuff->{no_nickoverride} = 1;
} else {
$stuff->{no_nickoverride} = 0;
}
unless ($self->{factoids}->exists($stuff->{channel}, $stuff->{keyword}, 'interpolate')
and $self->{factoids}->get_data($stuff->{channel}, $stuff->{keyword}, 'interpolate') eq '0')
{
if ($stuff->{code} =~ m/(?:\$\{?nick\b|\$\{?args\b|\$\{?arg\[)/ and length $stuff->{arguments}) { $stuff->{no_nickoverride} = 1; }
else { $stuff->{no_nickoverride} = 0; }
$stuff->{action} = $stuff->{code};
$stuff->{code} = $self->expand_factoid_vars($stuff);
@ -693,7 +645,10 @@ sub execute_code_factoid_using_vm {
$stuff->{no_nickoverride} = 0;
}
my %h = (nick => $stuff->{nick}, channel => $stuff->{from}, lang => $stuff->{lang}, code => $stuff->{code}, arguments => $stuff->{arguments}, factoid => "$stuff->{channel}:$stuff->{keyword}");
my %h = (
nick => $stuff->{nick}, channel => $stuff->{from}, lang => $stuff->{lang}, code => $stuff->{code}, arguments => $stuff->{arguments},
factoid => "$stuff->{channel}:$stuff->{keyword}"
);
if ($self->{factoids}->exists($stuff->{channel}, $stuff->{keyword}, 'persist-key')) {
$h{'persist-key'} = $self->{factoids}->get_data($stuff->{channel}, $stuff->{keyword}, 'persist-key');
@ -733,27 +688,24 @@ sub interpreter {
my $strictnamespace = $self->{pbot}->{registry}->get_value($stuff->{from}, 'strictnamespace');
if (not defined $strictnamespace) {
$strictnamespace = $self->{pbot}->{registry}->get_value('general', 'strictnamespace');
}
if (not defined $strictnamespace) { $strictnamespace = $self->{pbot}->{registry}->get_value('general', 'strictnamespace'); }
# search for factoid against global channel and current channel (from unless ref_from is defined)
my $original_keyword = $stuff->{keyword};
my ($channel, $keyword) = $self->find_factoid($stuff->{ref_from} ? $stuff->{ref_from} : $stuff->{from}, $stuff->{keyword}, arguments => $stuff->{arguments}, exact_channel => 1);
my ($channel, $keyword) =
$self->find_factoid($stuff->{ref_from} ? $stuff->{ref_from} : $stuff->{from}, $stuff->{keyword}, arguments => $stuff->{arguments}, exact_channel => 1);
if (not $stuff->{ref_from} or $stuff->{ref_from} eq '.*' or $stuff->{ref_from} eq $stuff->{from}) {
$stuff->{ref_from} = "";
}
if (not $stuff->{ref_from} or $stuff->{ref_from} eq '.*' or $stuff->{ref_from} eq $stuff->{from}) { $stuff->{ref_from} = ""; }
if (defined $channel and not $channel eq '.*' and not $channel eq lc $stuff->{from}) {
$stuff->{ref_from} = $channel;
}
if (defined $channel and not $channel eq '.*' and not $channel eq lc $stuff->{from}) { $stuff->{ref_from} = $channel; }
$stuff->{arguments} = "" if not defined $stuff->{arguments};
# if no match found, attempt to call factoid from another channel if it exists there
if (not defined $keyword) {
my $string = "$original_keyword $stuff->{arguments}";
my $lc_keyword = lc $original_keyword;
my $comma = "";
my $found = 0;
@ -782,6 +734,7 @@ sub interpreter {
return undef if $stuff->{referenced};
return $ref_from . "Ambiguous keyword '$original_keyword' exists in multiple channels (use 'fact <channel> $original_keyword' to choose one): $chans";
}
# if there's just one other channel that has this keyword, trigger that instance
elsif ($found == 1) {
$pbot->{logger}->log("Found '$original_keyword' as '$fwd_trig' in [$fwd_chan]\n");
@ -790,6 +743,7 @@ sub interpreter {
$stuff->{ref_from} = $fwd_chan;
return $pbot->{factoids}->interpreter($stuff);
}
# otherwise keyword hasn't been found, display similiar matches for all channels
else {
# if a non-nick argument was supplied, e.g., a sentence using the bot's nick, don't say anything
@ -799,9 +753,7 @@ sub interpreter {
$namespace = '.*' if $namespace !~ /^#/;
my $namespace_regex = $namespace;
if ($strictnamespace) {
$namespace_regex = "(?:" . (quotemeta $namespace) . '|\\.\\*)';
}
if ($strictnamespace) { $namespace_regex = "(?:" . (quotemeta $namespace) . '|\\.\\*)'; }
my $matches = $self->{commands}->factfind($stuff->{from}, $stuff->{nick}, $stuff->{user}, $stuff->{host}, quotemeta($original_keyword) . " -channel $namespace_regex");
@ -850,7 +802,10 @@ sub interpreter {
$ratelimit = $self->{factoids}->get_data($channel, $keyword, 'rate_limit') if not defined $ratelimit;
if (gettimeofday - $self->{factoids}->get_data($channel, $keyword, 'last_referenced_on') < $ratelimit) {
my $ref_from = $stuff->{ref_from} ? "[$stuff->{ref_from}] " : "";
return "/msg $stuff->{nick} $ref_from'$trigger_name' is rate-limited; try again in " . duration ($ratelimit - int(gettimeofday - $self->{factoids}->get_data($channel, $keyword, 'last_referenced_on'))) . "." unless $self->{pbot}->{users}->loggedin_admin($channel, "$stuff->{nick}!$stuff->{user}\@$stuff->{host}");
return
"/msg $stuff->{nick} $ref_from'$trigger_name' is rate-limited; try again in "
. duration($ratelimit - int(gettimeofday - $self->{factoids}->get_data($channel, $keyword, 'last_referenced_on'))) . "."
unless $self->{pbot}->{users}->loggedin_admin($channel, "$stuff->{nick}!$stuff->{user}\@$stuff->{host}");
}
}
}
@ -914,7 +869,8 @@ sub handle_action {
my $ref_from = $stuff->{ref_from} ? "[$stuff->{ref_from}] " : "";
unless ($self->{factoids}->exists($channel, $keyword, 'interpolate') and $self->{factoids}->get_data($channel, $keyword, 'interpolate') eq '0') {
my ($root_channel, $root_keyword) = $self->find_factoid($stuff->{ref_from} ? $stuff->{ref_from} : $stuff->{from}, $stuff->{root_keyword}, arguments => $stuff->{arguments}, exact_channel => 1);
my ($root_channel, $root_keyword) =
$self->find_factoid($stuff->{ref_from} ? $stuff->{ref_from} : $stuff->{from}, $stuff->{root_keyword}, arguments => $stuff->{arguments}, exact_channel => 1);
if (not defined $root_channel or not defined $root_keyword) {
$root_channel = $channel;
$root_keyword = $keyword;
@ -949,17 +905,15 @@ sub handle_action {
}
}
} else {
# no arguments supplied, replace $args with $nick/$tonick, etc
if ($self->{factoids}->exists($channel, $keyword, 'usage')) {
$action = "/say " . $self->{factoids}->get_data($channel, $keyword, 'usage');
$action =~ s/\$0|\$\{0\}/$trigger_name/g;
$stuff->{alldone} = 1;
} else {
if ($self->{factoids}->get_data($channel, $keyword, 'allow_empty_args')) {
$action = $self->expand_action_arguments($action, undef, '');
} else {
$action = $self->expand_action_arguments($action, undef, $stuff->{nick});
}
if ($self->{factoids}->get_data($channel, $keyword, 'allow_empty_args')) { $action = $self->expand_action_arguments($action, undef, ''); }
else { $action = $self->expand_action_arguments($action, undef, $stuff->{nick}); }
}
$stuff->{no_nickoverride} = 0;
}
@ -975,15 +929,14 @@ sub handle_action {
}
unless ($self->{factoids}->get_data($channel, $keyword, 'no_keyword_override')) {
if ($command =~ s/\s*--keyword-override=([^ ]+)\s*//) {
$stuff->{keyword_override} = $1;
}
if ($command =~ s/\s*--keyword-override=([^ ]+)\s*//) { $stuff->{keyword_override} = $1; }
}
$stuff->{command} = $command;
$stuff->{aliased} = 1;
$self->{pbot}->{logger}->log("[" . (defined $stuff->{from} ? $stuff->{from} : "stdin") . "] ($stuff->{nick}!$stuff->{user}\@$stuff->{host}) $trigger_name aliased to: $command\n");
$self->{pbot}->{logger}
->log("[" . (defined $stuff->{from} ? $stuff->{from} : "stdin") . "] ($stuff->{nick}!$stuff->{user}\@$stuff->{host}) $trigger_name aliased to: $command\n");
if (defined $self->{factoids}->get_data($channel, $keyword, 'cap-override')) {
if ($self->{factoids}->get_data($channel, $keyword, 'locked')) {
@ -997,7 +950,8 @@ sub handle_action {
return $self->{pbot}->{interpreter}->interpret($stuff);
}
$self->{pbot}->{logger}->log("(" . (defined $stuff->{from} ? $stuff->{from} : "(undef)") . "): $stuff->{nick}!$stuff->{user}\@$stuff->{host}: $trigger_name: action: \"$action\"\n");
$self->{pbot}->{logger}
->log("(" . (defined $stuff->{from} ? $stuff->{from} : "(undef)") . "): $stuff->{nick}!$stuff->{user}\@$stuff->{host}: $trigger_name: action: \"$action\"\n");
if ($self->{factoids}->get_data($channel, $keyword, 'enabled') == 0) {
$self->{pbot}->{logger}->log("$trigger_name disabled.\n");
@ -1005,7 +959,8 @@ sub handle_action {
}
unless ($self->{factoids}->exists($channel, $keyword, 'interpolate') and $self->{factoids}->get_data($channel, $keyword, 'interpolate') eq '0') {
my ($root_channel, $root_keyword) = $self->find_factoid($stuff->{ref_from} ? $stuff->{ref_from} : $stuff->{from}, $stuff->{root_keyword}, arguments => $stuff->{arguments}, exact_channel => 1);
my ($root_channel, $root_keyword) =
$self->find_factoid($stuff->{ref_from} ? $stuff->{ref_from} : $stuff->{from}, $stuff->{root_keyword}, arguments => $stuff->{arguments}, exact_channel => 1);
if (not defined $root_channel or not defined $root_keyword) {
$root_channel = $channel;
$root_keyword = $keyword;
@ -1016,11 +971,8 @@ sub handle_action {
$stuff->{action} = $action;
$action = $self->expand_factoid_vars($stuff);
if ($self->{factoids}->get_data($channel, $keyword, 'allow_empty_args')) {
$action = $self->expand_action_arguments($action, $stuff->{arguments}, '');
} else {
$action = $self->expand_action_arguments($action, $stuff->{arguments}, $stuff->{nick});
}
if ($self->{factoids}->get_data($channel, $keyword, 'allow_empty_args')) { $action = $self->expand_action_arguments($action, $stuff->{arguments}, ''); }
else { $action = $self->expand_action_arguments($action, $stuff->{arguments}, $stuff->{nick}); }
}
return $action if $stuff->{special} eq 'code-factoid';
@ -1034,13 +986,10 @@ sub handle_action {
$stuff->{root_channel} = $channel;
my $result = $self->{pbot}->{modules}->execute_module($stuff);
if (length $result) {
return $ref_from . $result;
} else {
return "";
}
}
elsif ($self->{factoids}->get_data($channel, $keyword, 'type') eq 'text') {
if (length $result) { return $ref_from . $result; }
else { return ""; }
} elsif ($self->{factoids}->get_data($channel, $keyword, 'type') eq 'text') {
# Don't allow user-custom /msg factoids, unless factoid triggered by admin
if ($action =~ m/^\/msg/i) {
my $admin = $self->{pbot}->{users}->loggedin_admin($stuff->{from}, "$stuff->{nick}!$stuff->{user}\@$stuff->{host}");
@ -1051,18 +1000,11 @@ sub handle_action {
}
if ($ref_from) {
if ($action =~ s/^\/say\s+/$ref_from/i || $action =~ s/^\/me\s+(.*)/\/me $1 $ref_from/i
|| $action =~ s/^\/msg\s+([^ ]+)/\/msg $1 $ref_from/i) {
return $action;
if ($action =~ s/^\/say\s+/$ref_from/i || $action =~ s/^\/me\s+(.*)/\/me $1 $ref_from/i || $action =~ s/^\/msg\s+([^ ]+)/\/msg $1 $ref_from/i) { return $action; }
else { return $ref_from . "$trigger_name is $action"; }
} else {
return $ref_from . "$trigger_name is $action";
}
} else {
if ($action =~ m/^\/(?:say|me|msg)/i) {
return $action;
} else {
return "/say $trigger_name is $action";
}
if ($action =~ m/^\/(?:say|me|msg)/i) { return $action; }
else { return "/say $trigger_name is $action"; }
}
} elsif ($self->{factoids}->get_data($channel, $keyword, 'type') eq 'regex') {
my $result = eval {
@ -1098,11 +1040,8 @@ sub handle_action {
return "";
}
if (length $result) {
return $ref_from . $result;
} else {
return "";
}
if (length $result) { return $ref_from . $result; }
else { return ""; }
} else {
$self->{pbot}->{logger}->log("($stuff->{from}): $stuff->{nick}!$stuff->{user}\@$stuff->{host}): Unknown command type for '$trigger_name'\n");
return "/me blinks." . " $ref_from";

15
PBot/Functions.pm
View File

@ -65,9 +65,7 @@ sub do_func {
return "[No such func '$func']" if not exists $self->{funcs}->{$func};
my @params;
while (my $param = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist})) {
push @params, $param;
}
while (my $param = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist})) { push @params, $param; }
my $result = $self->{funcs}->{$func}->{subref}->(@params);
$result =~ s/\x1/1/g;
@ -87,18 +85,13 @@ sub func_list {
my $result = eval {
my $text = '';
foreach my $func (sort keys %{$self->{funcs}}) {
if ($func =~ m/$regex/i or $self->{funcs}->{$func}->{desc} =~ m/$regex/i) {
$text .= "$func, ";
}
if ($func =~ m/$regex/i or $self->{funcs}->{$func}->{desc} =~ m/$regex/i) { $text .= "$func, "; }
}
$text =~ s/,\s+$//;
if (not length $text) {
if ($regex eq '.*') {
$text = "No funcs yet.";
} else {
$text = "No matching func.";
}
if ($regex eq '.*') { $text = "No funcs yet."; }
else { $text = "No matching func."; }
}
return "Available funcs: $text; see also: func help <keyword>";
};

22
PBot/HashObject.pm
View File

@ -38,7 +38,8 @@ sub initialize {
sub load {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
$self->clear;
@ -50,7 +51,7 @@ sub load {
$self->{pbot}->{logger}->log("Loading $self->{name} from $filename ...\n");
if (not open(FILE, "< $filename")) {
Carp::carp "Skipping loading from file: Couldn't open $filename: $!\n";
$self->{pbot}->{logger}->log("Skipping loading from file: Couldn't open $filename: $!\n");
return;
}
@ -66,12 +67,9 @@ sub load {
# and lowercase any non-lowercased entries
foreach my $index (keys %{$self->{hash}}) {
if (not exists $self->{hash}->{$index}->{_name}) {
if (lc $index eq $index) {
$self->{hash}->{$index}->{_name} = $index;
} else {
if (exists $self->{hash}->{lc $index}) {
Carp::croak "Cannot update $self->{name} object $index; duplicate object found";
}
if (lc $index eq $index) { $self->{hash}->{$index}->{_name} = $index; }
else {
if (exists $self->{hash}->{lc $index}) { Carp::croak "Cannot update $self->{name} object $index; duplicate object found"; }
my $data = delete $self->{hash}->{$index};
$data->{_name} = $index;
@ -84,7 +82,8 @@ sub load {
sub save {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
if (not defined $filename) {
Carp::carp "No $self->{name} filename specified -- skipping saving to file.\n";
@ -148,9 +147,8 @@ sub set {
return $result;
}
if (not defined $value) {
$value = $self->{hash}->{$lc_index}->{$key};
} else {
if (not defined $value) { $value = $self->{hash}->{$lc_index}->{$key}; }
else {
$self->{hash}->{$lc_index}->{$key} = $value;
$self->save unless $dont_save;
}

55
PBot/IRC.pm
View File

@ -13,7 +13,6 @@
#####################################################################
# $Id: IRC.pm,v 1.10 2004/04/30 18:02:51 jmuhlich Exp $
package PBot::IRC; # pragma_ 2011/01/21
BEGIN { require 5.004; } # needs IO::* and $coderef->(@args) syntax
@ -26,10 +25,7 @@ use Carp;
use feature 'unicode_strings';
# grab the drop-in replacement for time() from Time::HiRes, if it's available
BEGIN {
Time::HiRes->import('time') if eval "require Time::HiRes";
}
BEGIN { Time::HiRes->import('time') if eval "require Time::HiRes"; }
use strict;
use vars qw($VERSION);
@ -90,13 +86,9 @@ sub addfh {
if ($flag) {
foreach $letter (split(//, lc $flag)) {
if ($letter eq 'r') {
$self->{_read}->add( $fh );
} elsif ($letter eq 'w') {
$self->{_write}->add( $fh );
} elsif ($letter eq 'e') {
$self->{_error}->add( $fh );
}
if ($letter eq 'r') { $self->{_read}->add($fh); }
elsif ($letter eq 'w') { $self->{_write}->add($fh); }
elsif ($letter eq 'e') { $self->{_error}->add($fh); }
}
} else {
$self->{_read}->add($fh);
@ -110,9 +102,7 @@ sub addfh {
sub debug {
my $self = shift;
if (@_) {
$self->{_debug} = $_[0];
}
if (@_) { $self->{_debug} = $_[0]; }
return $self->{_debug};
}
@ -128,8 +118,7 @@ sub do_one_loop {
if (!$self->outputqueue->is_empty) {
my $outputevent = undef;
while (defined($outputevent = $self->outputqueue->head)
&& $outputevent->time <= $time) {
while (defined($outputevent = $self->outputqueue->head) && $outputevent->time <= $time) {
$outputevent = $self->outputqueue->dequeue();
$outputevent->content->{coderef}->(@{$outputevent->content->{args}});
}
@ -148,26 +137,23 @@ sub do_one_loop {
$scheduledevent = $self->schedulequeue->dequeue();
$scheduledevent->content->{coderef}->(@{$scheduledevent->content->{args}});
}
if (!$self->schedulequeue->is_empty()
&& $nexttimer
&& $self->schedulequeue->head->time < $nexttimer) {
$nexttimer = $self->schedulequeue->head->time;
}
if (!$self->schedulequeue->is_empty() && $nexttimer && $self->schedulequeue->head->time < $nexttimer) { $nexttimer = $self->schedulequeue->head->time; }
}
# Block until input arrives, then hand the filehandle over to the
# user-supplied coderef. Look! It's a freezer full of government cheese!
if ($nexttimer) {
$timeout = $nexttimer - $time < $self->{_timeout}
? $nexttimer - $time : $self->{_timeout};
} else {
$timeout = $self->{_timeout};
}
foreach $ev (IO::Select->select($self->{_read},
if ($nexttimer) { $timeout = $nexttimer - $time < $self->{_timeout} ? $nexttimer - $time : $self->{_timeout}; }
else { $timeout = $self->{_timeout}; }
foreach $ev (
IO::Select->select(
$self->{_read},
$self->{_write},
$self->{_error},
$timeout)) {
$timeout
)
)
{
foreach $sock (@{$ev}) {
my $conn = $self->{_connhash}->{$sock};
$conn or next;
@ -184,9 +170,7 @@ sub do_one_loop {
sub flush_output_queue {
my $self = shift;
while (!$self->outputqueue->is_empty()) {
$self->do_one_loop();
}
while (!$self->outputqueue->is_empty()) { $self->do_one_loop(); }
}
# Creates and returns a new Connection object.
@ -256,9 +240,7 @@ sub removefh {
sub start {
my $self = shift;
while (1) {
$self->do_one_loop();
}
while (1) { $self->do_one_loop(); }
}
# Sets or returns the current timeout, in seconds, for the select loop.
@ -273,7 +255,6 @@ sub timeout {
1;
__END__

522
PBot/IRC/Connection.pm
View File

File diff suppressed because it is too large Load Diff

304
PBot/IRC/DCC.pm
View File

@ -32,7 +32,6 @@ use feature 'unicode_strings';
# \merlyn: but he seems like a nice trucker guy...
# archon: you offered to shower with a random guy?
# Methods that can be shared between the various DCC classes.
package PBot::IRC::DCC::Connection; # pragma_ 2011/21/01
@ -44,40 +43,26 @@ sub fixaddr {
my ($address) = @_;
chomp $address; # just in case, sigh.
if ($address =~ /^\d+$/) {
return inet_ntoa(pack "N", $address);
} elsif ($address =~ /^[12]?\d{1,2}\.[12]?\d{1,2}\.[12]?\d{1,2}\.[12]?\d{1,2}$/) {
return $address;
} elsif ($address =~ tr/a-zA-Z//) { # Whee! Obfuscation!
if ($address =~ /^\d+$/) { return inet_ntoa(pack "N", $address); }
elsif ($address =~ /^[12]?\d{1,2}\.[12]?\d{1,2}\.[12]?\d{1,2}\.[12]?\d{1,2}$/) { return $address; }
elsif ($address =~ tr/a-zA-Z//) { # Whee! Obfuscation!
return inet_ntoa(((gethostbyname($address))[4])[0]);
} else {
return;
}
}
sub bytes_in {
return shift->{_bin};
}
sub bytes_in { return shift->{_bin}; }
sub bytes_out {
return shift->{_bout};
}
sub bytes_out { return shift->{_bout}; }
sub nick {
return shift->{_nick};
}
sub nick { return shift->{_nick}; }
sub socket {
return shift->{_socket};
}
sub socket { return shift->{_socket}; }
sub time {
return time - shift->{_time};
}
sub time { return time - shift->{_time}; }
sub debug {
return shift->{_debug};
}
sub debug { return shift->{_debug}; }
# Changes here 1998-04-01 by MJD
# Optional third argument `$block'.
@ -91,8 +76,7 @@ sub _getline {
$frag .= $input;
if (length($frag) > 0) {
warn "Got ". length($frag) ." bytes from $sock\n"
if $self->{_debug};
warn "Got " . length($frag) . " bytes from $sock\n" if $self->{_debug};
if ($block) { # Block mode (GET)
return $input;
@ -104,34 +88,41 @@ sub _getline {
$self->{_frag} = ($frag !~ /\012$/) ? pop @lines : '';
return (@lines);
}
}
else {
} else {
# um, if we can read, i say we should read more than 0
# besides, recv isn't returning undef on closed
# sockets. getting rid of this connection...
warn "recv() received 0 bytes in _getline, closing connection.\n"
if $self->{_debug};
warn "recv() received 0 bytes in _getline, closing connection.\n" if $self->{_debug};
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_parent}->parent->removefh($sock);
$self->{_socket}->close;
$self->{_fh}->close if $self->{_fh};
return;
}
} else {
# Error, lets scrap this connection
warn "recv() returned undef, socket error in _getline()\n"
if $self->{_debug};
warn "recv() returned undef, socket error in _getline()\n" if $self->{_debug};
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_parent}->parent->removefh($sock);
$self->{_socket}->close;
$self->{_fh}->close if $self->{_fh};
@ -146,10 +137,14 @@ sub DESTROY {
# live. Duplicate dcc_close events would be a Bad Thing.
if ($self->{_socket}->opened) {
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
close $self->{_fh} if $self->{_fh};
$self->{_parent}->{_parent}->parent->removeconn($self);
@ -157,9 +152,7 @@ sub DESTROY {
}
sub peer {
return ( $_[0]->{_nick}, "DCC " . $_[0]->{_type} );
}
sub peer { return ($_[0]->{_nick}, "DCC " . $_[0]->{_type}); }
# -- #perl was here! --
# orev: hehe...
@ -168,7 +161,6 @@ sub peer {
# tmtowtdi: \merlyn will be hacked to death by a psycho
# archon: yeah, but with is much more amusing
# Connection handling GETs
package PBot::IRC::DCC::GET; # pragma_ 2011/21/01
@ -180,8 +172,10 @@ use strict;
sub new {
my ($class, $container, $nick, $address,
$port, $size, $filename, $handle, $offset) = @_;
my (
$class, $container, $nick, $address,
$port, $size, $filename, $handle, $offset
) = @_;
my ($sock, $fh);
# get the address into a dotted quad
@ -192,24 +186,31 @@ sub new {
unless (defined $fh) {
carp "Can't open $filename for writing: $!";
$sock = new IO::Socket::INET( Proto => "tcp",
PeerAddr => "$address:$port" ) and
$sock->close();
$sock = new IO::Socket::INET(
Proto => "tcp",
PeerAddr => "$address:$port"
) and $sock->close();
return;
}
binmode $fh; # I love this next line. :-)
ref $fh eq 'GLOB' ? select((select($fh), $|++)[0]) : $fh->autoflush(1);
$sock = new IO::Socket::INET( Proto => "tcp",
PeerAddr => "$address:$port" );
$sock = new IO::Socket::INET(
Proto => "tcp",
PeerAddr => "$address:$port"
);
if (defined $sock) {
$container->handler(PBot::IRC::Event->new('dcc_open', # pragma_ 2011/21/01
$container->handler(
PBot::IRC::Event->new(
'dcc_open', # pragma_ 2011/21/01
$nick,
$sock,
'get',
'get', $sock));
'get', $sock
)
);
} else {
carp "Can't connect to $address: $!";
@ -258,26 +259,33 @@ sub parse {
carp("Error writing to " . $self->{_filename} . ": $!");
close $self->{_fh};
$self->{_parent}->parent->removeconn($self);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
$self->{_bin} += length($line);
# confirm the packet we've just recieved
unless ($self->{_socket}->send(pack("N", $self->{_bin}))) {
carp "Error writing to DCC GET socket: $!";
close $self->{_fh};
$self->{_parent}->parent->removeconn($self);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
@ -290,37 +298,45 @@ sub parse {
if ($self->{_size} and $self->{_size} <= $self->{_bin}) {
close $self->{_fh};
$self->{_parent}->parent->removeconn($self);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_update', # pragma_ 2011/21/01
$self->{_nick},
$self,
$self->{_type},
$self ));
$self
)
);
}
sub filename {
return shift->{_filename};
}
sub filename { return shift->{_filename}; }
sub size {
return shift->{_size};
}
sub size { return shift->{_size}; }
sub close {
my ($self, $sock) = @_;
$self->{_fh}->close;
$self->{_parent}->parent->removeconn($self);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
@ -335,7 +351,6 @@ sub close {
# Silmaril: AWWWWwwww yeeeaAAHH.
# archon: waka chica waka chica
# Connection handling SENDs
package PBot::IRC::DCC::SEND; # pragma_ 2011/21/01
@PBot::IRC::DCC::SEND::ISA = qw(Net::IRC::DCC::Connection); # pragma_ 2011/21/01
@ -367,8 +382,10 @@ sub new {
$size = $fh->tell;
$fh->seek(0, SEEK_SET);
$sock = new IO::Socket::INET( Proto => "tcp",
Listen => 1);
$sock = new IO::Socket::INET(
Proto => "tcp",
Listen => 1
);
unless (defined $sock) {
carp "Couldn't open DCC SEND socket: $!";
@ -376,9 +393,11 @@ sub new {
return;
}
$container->ctcp('DCC SEND', $nick, $filename,
$container->ctcp(
'DCC SEND', $nick, $filename,
unpack("N", inet_aton($container->hostname())),
$sock->sockport(), $size);
$sock->sockport(), $size
);
$sock->autoflush(1);
@ -431,15 +450,19 @@ sub parse {
$self->{_bin} += 4;
unless (defined $size) {
# Dang! The other end unexpectedly canceled.
carp (($self->peer)[1] . " connection to " .
($self->peer)[0] . " lost");
carp(($self->peer)[1] . " connection to " . ($self->peer)[0] . " lost");
$self->{_fh}->close;
$self->{_parent}->parent->removefh($sock);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
@ -452,13 +475,18 @@ sub parse {
warn "Other end acknowledged entire file ($size >= ",
$self->{_size}, ")";
}
# they've acknowledged the whole file, we outtie
$self->{_fh}->close;
$self->{_parent}->parent->removeconn($self);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
@ -469,41 +497,49 @@ sub parse {
unless (defined $self->{_fh}->read($buf, $self->{_blocksize})) {
if ($self->{_debug}) {
warn "Failed to read from source file in DCC SEND!";
}
if ($self->{_debug}) { warn "Failed to read from source file in DCC SEND!"; }
$self->{_fh}->close;
$self->{_parent}->parent->removeconn($self);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
unless ($self->{_socket}->send($buf)) {
if ($self->{_debug}) {
warn "send() failed horribly in DCC SEND"
}
if ($self->{_debug}) { warn "send() failed horribly in DCC SEND" }
$self->{_fh}->close;
$self->{_parent}->parent->removeconn($self);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
$self->{_bout} += length($buf);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_update', # pragma_ 2011/21/01
$self->{_nick},
$self,
$self->{_type},
$self ));
$self
)
);
return 1;
}
@ -517,7 +553,6 @@ sub parse {
# archon: she's in league with the guy in your shower
# archon: she gets you drunk and he takes your wallet!
# handles CHAT connections
package PBot::IRC::DCC::CHAT; # pragma_ 2011/21/01
@PBot::IRC::DCC::CHAT::ISA = qw(Net::IRC::DCC::Connection); # pragma_ 2011/21/01
@ -532,10 +567,13 @@ sub new {
my ($sock, $self);
if ($type) {
# we're initiating
$sock = new IO::Socket::INET( Proto => "tcp",
Listen => 1);
$sock = new IO::Socket::INET(
Proto => "tcp",
Listen => 1
);
unless (defined $sock) {
carp "Couldn't open DCC CHAT socket: $!";
@ -543,9 +581,11 @@ sub new {
}
$sock->autoflush(1);
$container->ctcp('DCC CHAT', $nick, 'chat',
$container->ctcp(
'DCC CHAT', $nick, 'chat',
unpack("N", inet_aton($container->hostname)),
$sock->sockport());
$sock->sockport()
);
$self = {
_bin => 0, # Bytes we've recieved thus far
@ -574,15 +614,21 @@ sub new {
$address = &PBot::IRC::DCC::Connection::fixaddr($address); # pragma_ 2011/21/01
return if $port < 1024 or not defined $address;
$sock = new IO::Socket::INET( Proto => "tcp",
PeerAddr => "$address:$port");
$sock = new IO::Socket::INET(
Proto => "tcp",
PeerAddr => "$address:$port"
);
if (defined $sock) {
$container->handler(PBot::IRC::Event->new('dcc_open', # pragma_ 2011/21/01
$container->handler(
PBot::IRC::Event->new(
'dcc_open', # pragma_ 2011/21/01
$nick,
$sock,
'chat',
'chat', $sock));
'chat', $sock
)
);
} else {
carp "Error in DCC CHAT connect: $!";
return;
@ -603,8 +649,10 @@ sub new {
bless $self, $class;
$self->{_parent}->parent->addfh($self->socket,
$self->can('parse'), 'r', $self);
$self->{_parent}->parent->addfh(
$self->socket,
$self->can('parse'), 'r', $self
);
}
return $self;
@ -630,17 +678,25 @@ sub parse {
return undef if $line eq "\012";
$self->{_bout} += length($line);
$self->{_parent}->handler(PBot::IRC::Event->new('chat', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'chat', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
'chat',
$line));
$line
)
);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_update', # pragma_ 2011/21/01
$self->{_nick},
$self,
$self->{_type},
$self ));
$self
)
);
}
}
@ -650,15 +706,12 @@ sub parse {
sub privmsg {
my ($self) = shift;
unless (@_) {
croak 'Not enough arguments to privmsg()';
}
unless (@_) { croak 'Not enough arguments to privmsg()'; }
# Don't send a CR over DCC CHAT -- it's not wanted.
$self->socket->send(join('', @_) . "\012");
}
# -- #perl was here! --
# \merlyn: this girl carly at the bar is aBABE
# archon: are you sure? you don't sound like you're in a condition to
@ -668,7 +721,6 @@ sub privmsg {
# tmtowtdi: uh, yeah...
# \merlyn: good topic
# Sockets waiting for accept() use this to shoehorn into the select loop.
package PBot::IRC::DCC::Accept; # pragma_ 2011/21/01
@ -677,12 +729,12 @@ use Carp;
use Socket; # we use a lot of Socket functions in parse()
use strict;
sub new {
my ($class, $sock, $parent) = @_;
my ($self);
$self = { _debug => $parent->debug,
$self = {
_debug => $parent->debug,
_nonblock => 1,
_socket => $sock,
_parent => $parent,
@ -708,20 +760,22 @@ sub parse {
$self->{_parent}->{_time} = time;
if ($self->{_parent}->{_type} eq 'SEND') {
# ok, to get the ball rolling, we send them the first packet.
my $buf;
unless (defined $self->{_parent}->{_fh}->
read($buf, $self->{_parent}->{_blocksize})) {
return;
}
unless (defined $self->{_parent}->{_fh}->read($buf, $self->{_parent}->{_blocksize})) { return; }
unless (defined $sock->send($buf)) {
$sock->close;
$self->{_parent}->{_fh}->close;
$self->{_parent}->{_parent}->parent->removefh($sock);
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_parent}->handler(
PBot::IRC::Event->new(
'dcc_close', # pragma_ 2011/21/01
$self->{_nick},
$self->{_socket},
$self->{_type}));
$self->{_type}
)
);
$self->{_socket}->close;
return;
}
@ -730,21 +784,21 @@ sub parse {
$self->{_parent}->{_parent}->parent->addconn($self->{_parent});
$self->{_parent}->{_parent}->parent->removeconn($self);
$self->{_parent}->{_parent}->handler(PBot::IRC::Event-> # pragma_ 2011/21/01
new('dcc_open',
$self->{_parent}->{_parent}->handler(
PBot::IRC::Event-> # pragma_ 2011/21/01
new(
'dcc_open',
$self->{_parent}->{_nick},
$self->{_parent}->{_socket},
$self->{_parent}->{_type},
$self->{_parent}->{_type},
$self->{_parent}->{_socket})
$self->{_parent}->{_socket}
)
);
}
1;
__END__
=head1 NAME

24
PBot/IRC/Event.pm
View File

@ -36,7 +36,9 @@ our %_names;
# the name of the format string for the event
# (optional) any number of arguments provided by the event
sub new {
my $class = shift;
my $type = shift;
my $from = shift;
my $to = shift;
@ -53,11 +55,8 @@ sub new {
bless $self, $class;
if ($self->type !~ /\D/) {
$self->type($self->trans($self->type));
} else {
$self->type(lc($self->type));
}
if ($self->type !~ /\D/) { $self->type($self->trans($self->type)); }
else { $self->type(lc($self->type)); }
$self->from($from); # sets nick, user, and host
$self->args($args); # strips colons from args
@ -100,9 +99,7 @@ sub dump {
printf STDERR "TYPE: %-30s FORMAT: %-30s\n", $self->type, $self->format;
print STDERR "FROM: ", $self->from, "\n";
print STDERR "TO: ", join(", ", @{$self->to}), "\n";
foreach $arg ($self->args) {
print STDERR "Arg ", $counter++, ": ", $arg, "\n";
}
foreach $arg ($self->args) { print STDERR "Arg ", $counter++, ": ", $arg, "\n"; }
}
# Sets or returns the format string for this event.
@ -121,17 +118,17 @@ sub from {
my @part;
if (@_) {
# avoid certain irritating and spurious warnings from this line...
{ local $^W;
{
local $^W;
@part = split /[\@!]/, $_[0], 3;
}
$self->nick(defined $part[0] ? $part[0] : '');
$self->user(defined $part[1] ? $part[1] : '');
$self->host(defined $part[2] ? $part[2] : '');
defined $self->user ?
$self->userhost($self->user . '@' . $self->host) :
$self->userhost($self->host);
defined $self->user ? $self->userhost($self->user . '@' . $self->host) : $self->userhost($self->host);
$self->{'from'} = $_[0];
}
@ -201,6 +198,7 @@ sub trans {
}
%_names = (
# suck! these aren't treated as strings --
# 001 ne 1 for the purpose of hash keying, apparently.
'001' => "welcome",
@ -476,10 +474,8 @@ sub trans {
'account' => 'account',
);
1;
__END__
=head1 NAME

84
PBot/IRCHandlers.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::IRCHandlers;
use parent 'PBot::Class';
use warnings; use strict;
@ -15,6 +16,7 @@ use feature 'unicode_strings';
use Time::HiRes qw(gettimeofday);
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
sub initialize {
@ -54,9 +56,7 @@ sub default_handler {
my ($self, $conn, $event) = @_;
if (not defined $self->{pbot}->{event_dispatcher}->dispatch_event("irc.$event->{type}", {conn => $conn, event => $event})) {
if ($self->{pbot}->{registry}->get_value('irc', 'log_default_handler')) {
$self->{pbot}->{logger}->log(Dumper $event);
}
if ($self->{pbot}->{registry}->get_value('irc', 'log_default_handler')) { $self->{pbot}->{logger}->log(Dumper $event); }
}
}
@ -133,6 +133,7 @@ sub on_self_part {
}
sub on_public {
my ($self, $event_type, $event) = @_;
my $from = $event->{event}->{to}[0];
@ -148,6 +149,7 @@ sub on_public {
}
sub on_msg {
my ($self, $event_type, $event) = @_;
my ($nick, $host) = ($event->{event}->nick, $event->{event}->host);
my $text = $event->{event}->{args}[0];
@ -178,18 +180,13 @@ sub on_notice {
$event->{conn}->privmsg("nickserv", "identify " . $self->{pbot}->{registry}->get_value('irc', 'identify_password'));
}
} elsif ($text =~ m/You are now identified/) {
if ($self->{pbot}->{registry}->get_value('irc', 'randomize_nick')) {
$event->{conn}->nick($self->{pbot}->{registry}->get_value('irc', 'botnick'));
} else {
$self->{pbot}->{channels}->autojoin;
}
if ($self->{pbot}->{registry}->get_value('irc', 'randomize_nick')) { $event->{conn}->nick($self->{pbot}->{registry}->get_value('irc', 'botnick')); }
else { $self->{pbot}->{channels}->autojoin; }
} elsif ($text =~ m/has been ghosted/) {
$event->{conn}->nick($self->{pbot}->{registry}->get_value('irc', 'botnick'));
}
} else {
if ($event->{event}->{to}[0] eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) {
$event->{event}->{to}[0] = $nick;
}
if ($event->{event}->{to}[0] eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) { $event->{event}->{to}[0] = $nick; }
$self->on_public($event_type, $event);
}
return 0;
@ -233,19 +230,14 @@ sub on_mode {
$self->{pbot}->{logger}->log("Mode $channel [$mode" . (length $target ? " $target" : '') . "] by $nick!$user\@$host\n");
if ($mode eq "-b" or $mode eq "+b" or $mode eq "-q" or $mode eq "+q") {
$self->{pbot}->{bantracker}->track_mode("$nick!$user\@$host", $mode, $target, $channel);
}
if ($mode eq "-b" or $mode eq "+b" or $mode eq "-q" or $mode eq "+q") { $self->{pbot}->{bantracker}->track_mode("$nick!$user\@$host", $mode, $target, $channel); }
if (defined $target and length $target) {
my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host);
$self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, "MODE $mode $target", $self->{pbot}->{messagehistory}->{MSG_CHAT});
if ($modifier eq '-') {
$self->{pbot}->{nicklist}->delete_meta($channel, $target, "+$mode_char");
} else {
$self->{pbot}->{nicklist}->set_meta($channel, $target, $mode, 1);
}
if ($modifier eq '-') { $self->{pbot}->{nicklist}->delete_meta($channel, $target, "+$mode_char"); }
else { $self->{pbot}->{nicklist}->set_meta($channel, $target, $mode, 1); }
} else {
my $modes = $self->{pbot}->{channels}->get_meta($channel, 'MODE');
if (defined $modes) {
@ -266,17 +258,14 @@ sub on_mode {
$self->{pbot}->{chanops}->{is_opped}->{$channel}{timeout} = gettimeofday + $timeout;
delete $self->{pbot}->{chanops}->{op_requested}->{$channel};
$self->{pbot}->{chanops}->perform_op_commands($channel);
}
elsif ($mode eq "-o") {
} elsif ($mode eq "-o") {
$self->{pbot}->{logger}->log("$nick removed my ops in $channel\n");
delete $self->{pbot}->{chanops}->{is_opped}->{$channel};
}
elsif ($mode eq "+b") {
} elsif ($mode eq "+b") {
$self->{pbot}->{logger}->log("Got banned in $channel, attempting unban.");
$event->{conn}->privmsg("chanserv", "unban $channel");
}
}
else { # bot not targeted
} else { # bot not targeted
if ($mode eq "+b") {
if ($nick eq "ChanServ" or $target =~ m/##fix_your_connection$/i) {
if ($self->{pbot}->{chanops}->can_gain_ops($channel)) {
@ -310,8 +299,7 @@ sub on_mode {
}
}
}
}
elsif ($mode eq "+q") {
} elsif ($mode eq "+q") {
if ($nick ne $event->{conn}->nick) { # bot muted
if ($self->{pbot}->{chanops}->can_gain_ops($channel)) {
if ($self->{pbot}->{chanops}->{unmute_timeout}->exists($channel, $target)) {
@ -362,10 +350,12 @@ sub on_join {
$self->{pbot}->{antiflood}->check_bans($message_account, $event->{event}->from, $channel);
}
$self->{pbot}->{antiflood}->check_flood($channel, $nick, $user, $host, $msg,
$self->{pbot}->{antiflood}->check_flood(
$channel, $nick, $user, $host, $msg,
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'),
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'),
$self->{pbot}->{messagehistory}->{MSG_JOIN});
$self->{pbot}->{messagehistory}->{MSG_JOIN}
);
return 0;
}
@ -380,9 +370,7 @@ sub on_invite {
$self->{pbot}->{logger}->log("$nick!$user\@$host invited $target to $channel!\n");
if ($target eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) {
if ($self->{pbot}->{channels}->is_active($channel)) {
$self->{pbot}->{interpreter}->add_botcmd_to_command_queue($channel, "join $channel", 0);
}
if ($self->{pbot}->{channels}->is_active($channel)) { $self->{pbot}->{interpreter}->add_botcmd_to_command_queue($channel, "join $channel", 0); }
}
return 0;
@ -390,7 +378,8 @@ sub on_invite {
sub on_kick {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $target, $channel, $reason) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to, $event->{event}->{args}[0], $event->{event}->{args}[1]);
my ($nick, $user, $host, $target, $channel, $reason) =
($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to, $event->{event}->{args}[0], $event->{event}->{args}[1]);
$channel = lc $channel;
($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host);
@ -407,10 +396,12 @@ sub on_kick {
my $text = "KICKED by $nick!$user\@$host ($reason)";
$self->{pbot}->{messagehistory}->add_message($message_account, $hostmask, $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
$self->{pbot}->{antiflood}->check_flood($channel, $target_nick, $target_user, $target_host, $text,
$self->{pbot}->{antiflood}->check_flood(
$channel, $target_nick, $target_user, $target_host, $text,
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'),
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'),
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE}
);
}
$message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account_id("$nick!$user\@$host");
@ -435,6 +426,7 @@ sub on_departure {
my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host);
if ($text =~ m/^QUIT/) {
# QUIT messages must be dispatched to each channel the user is on
my $channels = $self->{pbot}->{nicklist}->get_channels($nick);
foreach my $chan (@$channels) {
@ -445,10 +437,12 @@ sub on_departure {
$self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
}
$self->{pbot}->{antiflood}->check_flood($channel, $nick, $user, $host, $text,
$self->{pbot}->{antiflood}->check_flood(
$channel, $nick, $user, $host, $text,
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'),
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'),
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE}
);
my $u = $self->{pbot}->{users}->find_user($channel, "$nick!$user\@$host");
if (defined $u and $u->{loggedin} and not $u->{stayloggedin}) {
@ -481,9 +475,7 @@ sub on_cap {
$self->{pbot}->{logger}->log("Client capabilities granted: " . $event->{event}->{args}->[1] . "\n");
my @caps = split /\s+/, $event->{event}->{args}->[1];
foreach my $cap (@caps) {
$self->{pbot}->{irc_capabilities}->{$cap} = 1;
}
foreach my $cap (@caps) { $self->{pbot}->{irc_capabilities}->{$cap} = 1; }
} else {
$self->{pbot}->{logger}->log(Dumper $event->{event});
}
@ -516,10 +508,12 @@ sub on_nickchange {
$self->{pbot}->{messagehistory}->{database}->devalidate_all_channels($newnick_account, $self->{pbot}->{antiflood}->{NEEDS_CHECKBAN});
$self->{pbot}->{messagehistory}->{database}->update_hostmask_data("$newnick!$user\@$host", {last_seen => scalar gettimeofday});
$self->{pbot}->{antiflood}->check_flood("$nick!$user\@$host", $nick, $user, $host, "NICKCHANGE $newnick",
$self->{pbot}->{antiflood}->check_flood(
"$nick!$user\@$host", $nick, $user, $host, "NICKCHANGE $newnick",
$self->{pbot}->{registry}->get_value('antiflood', 'nick_flood_threshold'),
$self->{pbot}->{registry}->get_value('antiflood', 'nick_flood_time_threshold'),
$self->{pbot}->{messagehistory}->{MSG_NICKCHANGE});
$self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}
);
return 0;
}
@ -553,11 +547,13 @@ sub on_topic {
my ($self, $event_type, $event) = @_;
if (not length $event->{event}->{to}->[0]) {
# on join
my (undef, $channel, $topic) = $event->{event}->args;
$self->{pbot}->{logger}->log("Topic for $channel: $topic\n");
$self->{pbot}->{channels}->{channels}->set($channel, 'TOPIC', $topic, 1);
} else {
# user changing topic
my ($nick, $user, $host) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host);
my $channel = $event->{event}->{to}->[0];
@ -581,9 +577,7 @@ sub on_topicinfo {
sub normalize_hostmask {
my ($self, $nick, $user, $host) = @_;
if ($host =~ m{^(gateway|nat)/(.*)/x-[^/]+$}) {
$host = "$1/$2/x-$user";
}
if ($host =~ m{^(gateway|nat)/(.*)/x-[^/]+$}) { $host = "$1/$2/x-$user"; }
$host =~ s{/session$}{/x-$user};

44
PBot/IgnoreList.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::IgnoreList;
use parent 'PBot::Class';
use warnings; use strict;
@ -34,11 +35,8 @@ sub add {
my $self = shift;
my ($hostmask, $channel, $length) = @_;
if ($length < 0) {
$self->{ignore_list}->{$hostmask}->{$channel} = -1;
} else {
$self->{ignore_list}->{$hostmask}->{$channel} = gettimeofday + $length;
}
if ($length < 0) { $self->{ignore_list}->{$hostmask}->{$channel} = -1; }
else { $self->{ignore_list}->{$hostmask}->{$channel} = gettimeofday + $length; }
$self->save_ignores();
}
@ -49,9 +47,7 @@ sub remove {
delete $self->{ignore_list}->{$hostmask}->{$channel};
if (not keys %{ $self->{ignore_list}->{$hostmask} }) {
delete $self->{ignore_list}->{$hostmask};
}
if (not keys %{$self->{ignore_list}->{$hostmask}}) { delete $self->{ignore_list}->{$hostmask}; }
$self->save_ignores();
}
@ -65,7 +61,8 @@ sub load_ignores {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
if (not defined $filename) {
Carp::carp "No ignorelist path specified -- skipping loading of ignorelist";
@ -86,13 +83,9 @@ sub load_ignores {
my ($hostmask, $channel, $length) = split(/\s+/, $line);
if (not defined $hostmask || not defined $channel || not defined $length) {
Carp::croak "Syntax error around line $i of $filename\n";
}
if (not defined $hostmask || not defined $channel || not defined $length) { Carp::croak "Syntax error around line $i of $filename\n"; }
if (exists ${ $self->{ignore_list} }{$hostmask}{$channel}) {
Carp::croak "Duplicate ignore [$hostmask][$channel] found in $filename around line $i\n";
}
if (exists ${$self->{ignore_list}}{$hostmask}{$channel}) { Carp::croak "Duplicate ignore [$hostmask][$channel] found in $filename around line $i\n"; }
$self->{ignore_list}->{$hostmask}->{$channel} = $length;
}
@ -104,7 +97,8 @@ sub save_ignores {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
if (not defined $filename) {
Carp::carp "No ignorelist path specified -- skipping saving of ignorelist\n";
@ -134,17 +128,12 @@ sub check_ignore {
my $now = gettimeofday;
if (defined $channel) { # do not execute following if text is coming from STDIN ($channel undef)
if ($channel =~ /^#/) {
$self->{ignore_flood_counter}->{$channel}++;
}
if ($channel =~ /^#/) { $self->{ignore_flood_counter}->{$channel}++; }
if (not exists $self->{last_timestamp}->{$channel}) {
if (not exists $self->{last_timestamp}->{$channel}) { $self->{last_timestamp}->{$channel} = $now; }
elsif ($now - $self->{last_timestamp}->{$channel} >= 30) {
$self->{last_timestamp}->{$channel} = $now;
} elsif ($now - $self->{last_timestamp}->{$channel} >= 30) {
$self->{last_timestamp}->{$channel} = $now;
if (exists $self->{ignore_flood_counter}->{$channel} and $self->{ignore_flood_counter}->{$channel} > 0) {
$self->{ignore_flood_counter}->{$channel} = 0;
}
if (exists $self->{ignore_flood_counter}->{$channel} and $self->{ignore_flood_counter}->{$channel} > 0) { $self->{ignore_flood_counter}->{$channel} = 0; }
}
=cut
@ -158,6 +147,7 @@ sub check_ignore {
}
}
=cut
}
foreach my $ignored (keys %{$self->{ignore_list}}) {
@ -188,9 +178,7 @@ sub check_ignore_timeouts {
if ($self->{ignore_list}->{$hostmask}->{$channel} < $now) {
$self->{pbot}->{logger}->log("Unignoring $hostmask in channel $channel.\n");
$self->remove($hostmask, $channel);
if ($hostmask eq ".*") {
$self->{pbot}->{conn}->me($channel, "awakens.");
}
if ($hostmask eq ".*") { $self->{pbot}->{conn}->me($channel, "awakens."); }
}
}
}

29
PBot/IgnoreListCommands.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::IgnoreListCommands;
use parent 'PBot::Class';
use warnings; use strict;
@ -32,9 +33,7 @@ sub ignore_user {
my ($target, $channel, $length) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 3);
if (not defined $target) {
return "Usage: ignore <hostmask> [channel [timeout]]";
}
if (not defined $target) { return "Usage: ignore <hostmask> [channel [timeout]]"; }
if ($target =~ /^list$/i) {
my $text = "Ignored: ";
@ -42,7 +41,14 @@ sub ignore_user {
foreach my $ignored (sort keys %{$self->{pbot}->{ignorelist}->{ignore_list}}) {
foreach my $channel (sort keys %{${$self->{pbot}->{ignorelist}->{ignore_list}}{$ignored}}) {
$text .= $sep . "$ignored [$channel] " . ($self->{pbot}->{ignorelist}->{ignore_list}->{$ignored}->{$channel} < 0 ? "perm" : duration($self->{pbot}->{ignorelist}->{ignore_list}->{$ignored}->{$channel} - gettimeofday));
$text .=
$sep
. "$ignored [$channel] "
. (
$self->{pbot}->{ignorelist}->{ignore_list}->{$ignored}->{$channel} < 0
? "perm"
: duration($self->{pbot}->{ignorelist}->{ignore_list}->{$ignored}->{$channel} - gettimeofday)
);
$sep = ";\n";
}
}
@ -63,11 +69,8 @@ sub ignore_user {
$self->{pbot}->{ignorelist}->add($target, $channel, $length);
if ($length >= 0) {
$length = "for " . duration($length);
} else {
$length = "permanently";
}
if ($length >= 0) { $length = "for " . duration($length); }
else { $length = "permanently"; }
$self->{pbot}->{logger}->log("$nick added [$target][$channel] to ignore list $length\n");
return "/msg $nick [$target][$channel] added to ignore list $length";
@ -78,13 +81,9 @@ sub unignore_user {
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my ($target, $channel) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
if (not defined $target) {
return "Usage: unignore <hostmask> [channel]";
}
if (not defined $target) { return "Usage: unignore <hostmask> [channel]"; }
if (not defined $channel) {
$channel = ".*";
}
if (not defined $channel) { $channel = ".*"; }
if (exists $self->{pbot}->{ignorelist}->{ignore_list}->{$target} and not exists $self->{pbot}->{ignorelist}->{ignore_list}->{$target}->{$channel}) {
$self->{pbot}->{logger}->log("$nick attempt to remove nonexistent [$target][$channel] from ignore list\n");

149
PBot/Interpreter.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::Interpreter;
use parent 'PBot::Class', 'PBot::Registerable';
use warnings; use strict;
@ -58,20 +59,18 @@ sub process_line {
$stuff->{'chan-z'} = 1;
if (exists $self->{pbot}->{bantracker}->{banlist}->{$from}->{'+q'}->{'$~a'}) {
my $nickserv = $self->{pbot}->{messagehistory}->{database}->get_current_nickserv_account($message_account);
if (not defined $nickserv or not length $nickserv) {
$stuff->{unidentified} = 1;
if (not defined $nickserv or not length $nickserv) { $stuff->{unidentified} = 1; }
}
if ($self->{pbot}->{bantracker}->is_banned($nick, $user, $host, $from)) { $stuff->{banned} = 1; }
}
}
if ($self->{pbot}->{bantracker}->is_banned($nick, $user, $host, $from)) {
$stuff->{banned} = 1;
}
}
}
$pbot->{antiflood}->check_flood($from, $nick, $user, $host, $text,
$pbot->{antiflood}->check_flood(
$from, $nick, $user, $host, $text,
$flood_threshold, $flood_time_threshold,
$pbot->{messagehistory}->{MSG_CHAT}, $stuff) if defined $from;
$pbot->{messagehistory}->{MSG_CHAT}, $stuff
) if defined $from;
if ($stuff->{banned} or $stuff->{unidentified}) {
$self->{pbot}->{logger}->log("Disregarding banned/unidentified user message (channel $from is +z).\n");
@ -84,9 +83,7 @@ sub process_line {
my $bot_trigger = $pbot->{registry}->get_value($from, 'trigger');
# otherwise get general trigger
if (not defined $bot_trigger) {
$bot_trigger = $pbot->{registry}->get_value('general', 'trigger');
}
if (not defined $bot_trigger) { $bot_trigger = $pbot->{registry}->get_value('general', 'trigger'); }
my $nick_regex = qr/[^%!,:\(\)\+\*\/ ]+/;
@ -106,18 +103,15 @@ sub process_line {
my $command;
my $embedded = 0;
if ($cmd_text =~ m/^\s*($nick_regex)[,:]?\s+$bot_trigger\{\s*(.+?)\s*\}\s*$/) {
goto CHECK_EMBEDDED_CMD;
} elsif ($cmd_text =~ m/^\s*$bot_trigger\{\s*(.+?)\s*\}\s*$/) {
goto CHECK_EMBEDDED_CMD;
} elsif ($cmd_text =~ m/^\s*($nick_regex)[,:]\s+$bot_trigger\s*(.+)$/) {
if ($cmd_text =~ m/^\s*($nick_regex)[,:]?\s+$bot_trigger\{\s*(.+?)\s*\}\s*$/) { goto CHECK_EMBEDDED_CMD; }
elsif ($cmd_text =~ m/^\s*$bot_trigger\{\s*(.+?)\s*\}\s*$/) { goto CHECK_EMBEDDED_CMD; }
elsif ($cmd_text =~ m/^\s*($nick_regex)[,:]\s+$bot_trigger\s*(.+)$/) {
my $possible_nick_override = $1;
$command = $2;
my $similar = $self->{pbot}->{nicklist}->is_present_similar($from, $possible_nick_override);
if ($similar) {
$nick_override = $similar;
} else {
if ($similar) { $nick_override = $similar; }
else {
$self->{pbot}->{logger}->log("No similar nick for $possible_nick_override\n");
return 0;
}
@ -135,9 +129,7 @@ sub process_line {
if ($cmd_text =~ s/^\s*($nick_regex)[,:]\s+//) {
my $possible_nick_override = $1;
my $similar = $self->{pbot}->{nicklist}->is_present_similar($from, $possible_nick_override);
if ($similar) {
$nick_override = $similar;
}
if ($similar) { $nick_override = $similar; }
}
for (my $count = 0; $count < 3; $count++) {
@ -153,6 +145,7 @@ sub process_line {
}
foreach $command (@commands) {
# check if user is ignored (and command isn't `login`)
if ($command !~ /^login / && defined $from && $pbot->{ignorelist}->check_ignore($nick, $user, $host, $from)) {
if (not $pbot->{users}->loggedin_admin($from, "$nick!$user\@$host")) {
@ -185,7 +178,9 @@ sub interpret {
my $text;
my $pbot = $self->{pbot};
$pbot->{logger}->log("=== [$stuff->{interpret_depth}] Got command: (" . (defined $stuff->{from} ? $stuff->{from} : "undef") . ") $stuff->{nick}!$stuff->{user}\@$stuff->{host}: $stuff->{command}\n");
$pbot->{logger}->log("=== [$stuff->{interpret_depth}] Got command: ("
. (defined $stuff->{from} ? $stuff->{from} : "undef")
. ") $stuff->{nick}!$stuff->{user}\@$stuff->{host}: $stuff->{command}\n");
$stuff->{special} = "" unless exists $self->{special};
@ -214,6 +209,7 @@ sub interpret {
push @{$stuff->{commands}}, $stuff->{command};
if ($self->arglist_size($cmdlist) >= 4 and lc $cmdlist->[0] eq 'tell' and (lc $cmdlist->[2] eq 'about' or lc $cmdlist->[2] eq 'the')) {
# tell nick about/the cmd [args]
$stuff->{nickoverride} = $cmdlist->[1];
($keyword, $arguments) = $self->split_args($cmdlist, 2, 3, 1);
@ -227,6 +223,7 @@ sub interpret {
delete $stuff->{force_nickoverride};
}
} else {
# normal command
($keyword, $arguments) = $self->split_args($cmdlist, 2, 0, 1);
$arguments = "" if not defined $arguments;
@ -261,15 +258,14 @@ sub interpret {
$arguments =~ s/\s*(?<!\\)\|\s*{(\Q$pipe\E)}.*$//s;
$pipe =~ s/^\s+|\s+$//g;
if (exists $stuff->{pipe}) {
$stuff->{pipe_rest} = "$rest | { $stuff->{pipe} }$stuff->{pipe_rest}";
} else {
$stuff->{pipe_rest} = $rest;
}
if (exists $stuff->{pipe}) { $stuff->{pipe_rest} = "$rest | { $stuff->{pipe} }$stuff->{pipe_rest}"; }
else { $stuff->{pipe_rest} = $rest; }
$stuff->{pipe} = $pipe;
}
if (not $self->{pbot}->{commands}->get_meta($keyword, 'dont-replace-pronouns') and not $self->{pbot}->{factoids}->get_meta($stuff->{from}, $keyword, 'dont-replace-pronouns')) {
if ( not $self->{pbot}->{commands}->get_meta($keyword, 'dont-replace-pronouns')
and not $self->{pbot}->{factoids}->get_meta($stuff->{from}, $keyword, 'dont-replace-pronouns'))
{
$stuff->{nickoverride} = $stuff->{nick} if defined $stuff->{nickoverride} and lc $stuff->{nickoverride} eq 'me';
$keyword =~ s/(\w+)([?!.]+)$/$1/;
$arguments =~ s/(?<![\w\/\-\\])i am\b/$stuff->{nick} is/gi if defined $arguments && $stuff->{interpret_depth} <= 2;
@ -300,9 +296,7 @@ sub interpret {
return undef;
}
if (not exists $stuff->{root_keyword}) {
$stuff->{root_keyword} = $keyword;
}
if (not exists $stuff->{root_keyword}) { $stuff->{root_keyword} = $keyword; }
$stuff->{keyword} = $keyword;
$stuff->{original_arguments} = $arguments;
@ -330,6 +324,7 @@ sub interpret {
foreach my $func (@{$self->{handlers}}) {
$result = &{$func->{subref}}($stuff);
last if defined $result;
# reset any manipulated arguments
$stuff->{arguments} = $stuff->{original_arguments};
delete $stuff->{args_utf8};
@ -350,9 +345,7 @@ sub extract_bracketed {
my @prefix_group;
if ($optional_prefix =~ s/^\[(.*?)\]//) {
@prefix_group = split //, $1;
}
if ($optional_prefix =~ s/^\[(.*?)\]//) { @prefix_group = split //, $1; }
my @prefixes = split //, $optional_prefix;
my @opens = split //, $open_bracket;
@ -386,6 +379,7 @@ sub extract_bracketed {
if ($i >= @chars) {
if ($extracting) {
# reached end, but unbalanced brackets... reset to beginning and ignore them
$i = $bracket_pos;
$bracket_level = 0;
@ -395,6 +389,7 @@ sub extract_bracketed {
$token = '';
$result = '';
} else {
# add final token and exit
$rest .= $token if $extracted;
last;
@ -449,9 +444,8 @@ sub extract_bracketed {
$match = 1;
$open_index++;
} else {
if ($allow_whitespace and $ch eq ' ' and not $extracting) {
next;
} elsif (not $extracting) {
if ($allow_whitespace and $ch eq ' ' and not $extracting) { next; }
elsif (not $extracting) {
$state = 'prefixgroup';
next;
}
@ -496,9 +490,7 @@ sub extract_bracketed {
}
}
if ($extracting or $extracted) {
$token .= $ch;
}
if ($extracting or $extracted) { $token .= $ch; }
}
return ($result, $rest);
@ -540,6 +532,7 @@ sub split_line {
if ($i >= @chars) {
if (defined $quote) {
# reached end, but unbalanced quote... reset to beginning of quote and ignore it
$i = $pos;
$ignore_quote = 1;
@ -547,6 +540,7 @@ sub split_line {
$last_ch = ' ';
$token = $last_token;
} else {
# add final token and exit
push @args, $token if length $token;
last;
@ -559,11 +553,8 @@ sub split_line {
$spaces = 0 if $ch ne ' ';
if ($escaped) {
if ($opts{preserve_escapes}) {
$token .= "\\$ch";
} else {
$token .= $ch;
}
if ($opts{preserve_escapes}) { $token .= "\\$ch"; }
else { $token .= $ch; }
$escaped = 0;
next;
}
@ -575,12 +566,14 @@ sub split_line {
if (defined $quote) {
if ($ch eq $quote and (not defined $next_ch or $next_ch =~ /[\s,:;})\].+=]/)) {
# closing quote
$token .= $ch unless $opts{strip_quotes};
push @args, $token;
$quote = undef;
$token = '';
} else {
# still within quoted argument
$token .= $ch;
}
@ -589,10 +582,12 @@ sub split_line {
if (($last_ch =~ /[\s:{(\[.+=]/) and not defined $quote and ($ch eq "'" or $ch eq '"')) {
if ($ignore_quote) {
# treat unbalanced quote as part of this argument
$token .= $ch;
$ignore_quote = 0;
} else {
# begin potential quoted argument
$pos = $i - 1;
$quote = $ch;
@ -704,6 +699,7 @@ sub split_args {
# join the get rest as a string
my $rest;
if ($preserve_quotes) {
# get from second half of args, which contains quotes
$rest = join ' ', @$args[@$args / 2 + $i .. @$args - 1];
} else {
@ -716,9 +712,7 @@ sub split_args {
# lowercases array of arguments
sub lc_args {
my ($self, $args) = @_;
for (my $i = 0; $i < @$args; $i++) {
$args->[$i] = lc $args->[$i];
}
for (my $i = 0; $i < @$args; $i++) { $args->[$i] = lc $args->[$i]; }
}
sub truncate_result {
@ -735,11 +729,8 @@ sub truncate_result {
}
my $trunc = "... [truncated; ";
if ($link =~ m/^http/) {
$trunc .= "see $link for full text.]";
} else {
$trunc .= "$link]";
}
if ($link =~ m/^http/) { $trunc .= "see $link for full text.]"; }
else { $trunc .= "$link]"; }
$self->{pbot}->{logger}->log("Message truncated -- pasted to $link\n") if $paste;
@ -765,11 +756,8 @@ sub handle_result {
return 0 if not defined $result or length $result == 0;
if ($result =~ s#^(/say|/me) ##) {
$stuff->{prepend} = $1;
} elsif ($result =~ s#^(/msg \S+) ##) {
$stuff->{prepend} = $1;
}
if ($result =~ s#^(/say|/me) ##) { $stuff->{prepend} = $1; }
elsif ($result =~ s#^(/msg \S+) ##) { $stuff->{prepend} = $1; }
if ($stuff->{pipe}) {
my ($pipe, $pipe_rest) = (delete $stuff->{pipe}, delete $stuff->{pipe_rest});
@ -785,9 +773,7 @@ sub handle_result {
if (exists $stuff->{subcmd}) {
my $command = pop @{$stuff->{subcmd}};
if (@{$stuff->{subcmd}} == 0 or $stuff->{alldone}) {
delete $stuff->{subcmd};
}
if (@{$stuff->{subcmd}} == 0 or $stuff->{alldone}) { delete $stuff->{subcmd}; }
$command =~ s/&\{subcmd\}/$result/;
@ -800,9 +786,7 @@ sub handle_result {
return 0;
}
if ($stuff->{prepend}) {
$result = "$stuff->{prepend} $result";
}
if ($stuff->{prepend}) { $result = "$stuff->{prepend} $result"; }
if ($stuff->{command_split}) {
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
@ -879,11 +863,8 @@ sub handle_result {
last;
}
if ($preserve_newlines) {
$line = $self->truncate_result($stuff->{from}, $stuff->{nick}, $stuff->{text}, $line, $line, 1);
} else {
$line = $self->truncate_result($stuff->{from}, $stuff->{nick}, $stuff->{text}, $original_result, $line, 1);
}
if ($preserve_newlines) { $line = $self->truncate_result($stuff->{from}, $stuff->{nick}, $stuff->{text}, $line, $line, 1); }
else { $line = $self->truncate_result($stuff->{from}, $stuff->{nick}, $stuff->{text}, $original_result, $line, 1); }
if ($use_output_queue) {
my $delay = rand(10) + 5;
@ -940,17 +921,17 @@ sub output_result {
$line = $self->dehighlight_nicks($line, $stuff->{from}) if $stuff->{from} =~ /^#/ and $line !~ /^\/msg\s+/i;
if ($line =~ s/^\/say\s+//i) {
if (defined $stuff->{nickoverride} and ($stuff->{no_nickoverride} == 0 or $stuff->{force_nickoverride} == 1)) {
$line = "$stuff->{nickoverride}: $line";
}
if (defined $stuff->{nickoverride} and ($stuff->{no_nickoverride} == 0 or $stuff->{force_nickoverride} == 1)) { $line = "$stuff->{nickoverride}: $line"; }
$pbot->{conn}->privmsg($stuff->{from}, $line) if defined $stuff->{from} && $stuff->{from} ne $botnick;
$pbot->{antiflood}->check_flood($stuff->{from}, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'pbot', $line, 0, 0, 0) if $stuff->{checkflood};
} elsif ($line =~ s/^\/me\s+//i) {
=cut
if (defined $stuff->{nickoverride}) {
$line = "$line (for $stuff->{nickoverride})";
}
=cut
$pbot->{conn}->me($stuff->{from}, $line) if defined $stuff->{from} && $stuff->{from} ne $botnick;
$pbot->{antiflood}->check_flood($stuff->{from}, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'pbot', '/me ' . $line, 0, 0, 0) if $stuff->{checkflood};
} elsif ($line =~ s/^\/msg\s+([^\s]+)\s+//i) {
@ -960,25 +941,23 @@ sub output_result {
} elsif ($to =~ /.*serv(?:@.*)?$/i) {
$pbot->{logger}->log("[HACK] Possible HACK ATTEMPT /msg *serv: [$stuff->{nick}!$stuff->{user}\@$stuff->{host}] [$stuff->{command}] [$line]\n");
} elsif ($line =~ s/^\/me\s+//i) {
=cut
if (defined $stuff->{nickoverride}) {
$line = "$line (for $stuff->{nickoverride})";
}
=cut
$pbot->{conn}->me($to, $line) if $to ne $botnick;
$pbot->{antiflood}->check_flood($to, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'pbot', '/me ' . $line, 0, 0, 0) if $stuff->{checkflood};
} else {
$line =~ s/^\/say\s+//i;
if (defined $stuff->{nickoverride} and ($stuff->{no_nickoverride} == 0 or $stuff->{force_nickoverride} == 1)) {
$line = "$stuff->{nickoverride}: $line";
}
if (defined $stuff->{nickoverride} and ($stuff->{no_nickoverride} == 0 or $stuff->{force_nickoverride} == 1)) { $line = "$stuff->{nickoverride}: $line"; }
$pbot->{conn}->privmsg($to, $line) if $to ne $botnick;
$pbot->{antiflood}->check_flood($to, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'pbot', $line, 0, 0, 0) if $stuff->{checkflood};
}
} else {
if (defined $stuff->{nickoverride} and ($stuff->{no_nickoverride} == 0 or $stuff->{force_nickoverride} == 1)) {
$line = "$stuff->{nickoverride}: $line";
}
if (defined $stuff->{nickoverride} and ($stuff->{no_nickoverride} == 0 or $stuff->{force_nickoverride} == 1)) { $line = "$stuff->{nickoverride}: $line"; }
$pbot->{conn}->privmsg($stuff->{from}, $line) if defined $stuff->{from} && $stuff->{from} ne $botnick;
$pbot->{antiflood}->check_flood($stuff->{from}, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'pbot', $line, 0, 0, 0) if $stuff->{checkflood};
}
@ -1021,9 +1000,7 @@ sub process_output_queue {
}
}
if (not @{$self->{output_queue}->{$channel}}) {
delete $self->{output_queue}->{$channel};
}
if (not @{$self->{output_queue}->{$channel}}) { delete $self->{output_queue}->{$channel}; }
}
}
@ -1078,9 +1055,7 @@ sub process_command_queue {
}
}
if (not @{$self->{command_queue}->{$channel}}) {
delete $self->{command_queue}->{$channel};
}
if (not @{$self->{command_queue}->{$channel}}) { delete $self->{command_queue}->{$channel}; }
}
}

5
PBot/LagChecker.pm
View File

@ -9,6 +9,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::LagChecker;
use parent 'PBot::Class';
use warnings; use strict;
@ -27,8 +28,10 @@ sub initialize {
# maximum number of lag history entries to retain
$self->{pbot}->{registry}->add_default('text', 'lagchecker', 'lag_history_max', $conf{lag_history_max} // 3);
# lagging is true if lag_average reaches or exceeds this threshold, in milliseconds
$self->{pbot}->{registry}->add_default('text', 'lagchecker', 'lag_threshold', $conf{lag_threshhold} // 2000);
# how often to send PING, in seconds
$self->{pbot}->{registry}->add_default('text', 'lagchecker', 'lag_history_interval', $conf{lag_history_interval} // 10);
@ -96,6 +99,7 @@ sub lagging {
my $self = shift;
if (defined $self->{pong_received} and $self->{pong_received} == 0) {
# a ping has been sent (pong_received is not undef) and no pong has been received yet
my $elapsed = tv_interval($self->{ping_send_time});
return $elapsed >= $self->{pbot}->{registry}->get_value('lagchecker', 'lag_threshold');
@ -115,6 +119,7 @@ sub lagcheck {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
if (defined $self->{pong_received} and $self->{pong_received} == 0) {
# a ping has been sent (pong_received is not undef) and no pong has been received yet
my $elapsed = tv_interval($self->{ping_send_time});
my $lag_total = $elapsed;

1
PBot/Logger.pm
View File

@ -53,6 +53,7 @@ sub rotate_log {
$time =~ s/\s+/_/g;
$self->log("Rotating log to $self->{logfile}-$time\n");
# logfile has to be closed first for maximum compatibility with `rename`
close LOGFILE;
rename $self->{logfile}, $self->{logfile} . '-' . $time;

122
PBot/MessageHistory.pm
View File

@ -12,6 +12,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::MessageHistory;
use parent 'PBot::Class';
use warnings; use strict;
@ -74,20 +75,14 @@ sub aka_link {
$type = $self->{database}->{alias_type}->{STRONG} if not defined $type;
if (not $id or not $alias) {
return "Usage: link <target id> <alias id> [type]";
}
if (not $id or not $alias) { return "Usage: link <target id> <alias id> [type]"; }
my $source = $self->{database}->find_most_recent_hostmask($id);
my $target = $self->{database}->find_most_recent_hostmask($alias);
if (not $source) {
return "No such id $id found.";
}
if (not $source) { return "No such id $id found."; }
if (not $target) {
return "No such id $alias found.";
}
if (not $target) { return "No such id $alias found."; }
if ($self->{database}->link_alias($id, $alias, $type)) {
return "/say $source " . ($type == $self->{database}->{alias_type}->{WEAK} ? "weakly" : "strongly") . " linked to $target.";
@ -101,26 +96,17 @@ sub aka_unlink {
my ($id, $alias) = split /\s+/, $arguments;
if (not $id or not $alias) {
return "Usage: unlink <target id> <alias id>";
}
if (not $id or not $alias) { return "Usage: unlink <target id> <alias id>"; }
my $source = $self->{database}->find_most_recent_hostmask($id);
my $target = $self->{database}->find_most_recent_hostmask($alias);
if (not $source) {
return "No such id $id found.";
}
if (not $source) { return "No such id $id found."; }
if (not $target) {
return "No such id $alias found.";
}
if (not $target) { return "No such id $alias found."; }
if ($self->{database}->unlink_alias($id, $alias)) {
return "/say $source unlinked from $target.";
} else {
return "Unlink failed.";
}
if ($self->{database}->unlink_alias($id, $alias)) { return "/say $source unlinked from $target."; }
else { return "Unlink failed."; }
}
sub list_also_known_as {
@ -128,9 +114,7 @@ sub list_also_known_as {
my $usage = "Usage: aka [-hingr] <nick>; -h show hostmasks; -i show ids; -n show nickserv accounts; -g show gecos, -r show relationships";
if (not length $arguments) {
return $usage;
}
if (not length $arguments) { return $usage; }
my $getopt_error;
local $SIG{__WARN__} = sub {
@ -141,14 +125,16 @@ sub list_also_known_as {
Getopt::Long::Configure("bundling");
my ($show_hostmasks, $show_gecos, $show_nickserv, $show_id, $show_relationship, $show_weak, $dont_use_aliases_table);
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
'h' => \$show_hostmasks,
'n' => \$show_nickserv,
'r' => \$show_relationship,
'g' => \$show_gecos,
'w' => \$show_weak,
'nt' => \$dont_use_aliases_table,
'i' => \$show_id);
'i' => \$show_id
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
return "Too many arguments -- $usage" if @$args > 1;
@ -179,22 +165,16 @@ sub list_also_known_as {
$result .= " {$akas{$aka}->{gecos}}" if $show_gecos and exists $akas{$aka}->{gecos};
if ($show_relationship) {
if ($akas{$aka}->{id} == $akas{$aka}->{alias}) {
$result .= " [$akas{$aka}->{id}]";
} else {
$result .= " [$akas{$aka}->{id} -> $akas{$aka}->{alias}]";
}
if ($akas{$aka}->{id} == $akas{$aka}->{alias}) { $result .= " [$akas{$aka}->{id}]"; }
else { $result .= " [$akas{$aka}->{id} -> $akas{$aka}->{alias}]"; }
} elsif ($show_id) {
$result .= " [$akas{$aka}->{id}]";
}
$result .= " [WEAK]" if $akas{$aka}->{type} == $self->{database}->{alias_type}->{WEAK};
if ($show_hostmasks or $show_nickserv or $show_gecos or $show_id or $show_relationship) {
$sep = ",\n";
} else {
$sep = ", ";
}
if ($show_hostmasks or $show_nickserv or $show_gecos or $show_id or $show_relationship) { $sep = ",\n"; }
else { $sep = ", "; }
}
return $result;
} else {
@ -210,11 +190,10 @@ sub recall_message {
return "";
}
my $usage = 'Usage: recall [nick [history [channel]]] [-c,channel <channel>] [-t,text,h,history <history>] [-b,before <context before>] [-a,after <context after>] [-x,context <nick>] [-n,count <count>] [+ ...]';
my $usage =
'Usage: recall [nick [history [channel]]] [-c,channel <channel>] [-t,text,h,history <history>] [-b,before <context before>] [-a,after <context after>] [-x,context <nick>] [-n,count <count>] [+ ...]';
if (not defined $arguments or not length $arguments) {
return $usage;
}
if (not defined $arguments or not length $arguments) { return $usage; }
$arguments = lc $arguments;
@ -232,13 +211,15 @@ sub recall_message {
foreach my $recall (@recalls) {
my ($recall_nick, $recall_history, $recall_channel, $recall_before, $recall_after, $recall_context, $recall_count);
my ($ret, $args) = GetOptionsFromString($recall,
my ($ret, $args) = GetOptionsFromString(
$recall,
'channel|c:s' => \$recall_channel,
'text|t|history|h:s' => \$recall_history,
'before|b:i' => \$recall_before,
'after|a:i' => \$recall_after,
'count|n:i' => \$recall_count,
'context|x:s' => \$recall_context);
'context|x:s' => \$recall_context
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
@ -256,9 +237,7 @@ sub recall_message {
$recall_after = 0 if not defined $recall_after;
# imply -x if -n > 1 and no history
if ($recall_count > 1 and not defined $recall_history) {
$recall_context = $recall_nick;
}
if ($recall_count > 1 and not defined $recall_history) { $recall_context = $recall_nick; }
# make -n behave like -b if -n > 1 and nick is context
if ((defined $recall_context or not defined $recall_history) and $recall_count > 1) {
@ -266,13 +245,9 @@ sub recall_message {
$recall_count = 0;
}
if ($recall_before + $recall_after > 200) {
return "You may only select up to 200 lines of surrounding context.";
}
if ($recall_before + $recall_after > 200) { return "You may only select up to 200 lines of surrounding context."; }
if ($recall_count > 1 and ($recall_before > 0 or $recall_after > 0)) {
return "The `count` and `context before/after` options cannot be used together.";
}
if ($recall_count > 1 and ($recall_before > 0 or $recall_after > 0)) { return "The `count` and `context before/after` options cannot be used together."; }
# swap nick and channel if recall nick looks like channel and channel wasn't specified
if (not $channel_arg and $recall_nick =~ m/^#/) {
@ -305,18 +280,14 @@ sub recall_message {
$recall_channel = $from;
}
if (not defined $recall_nick and defined $recall_context) {
$recall_nick = $recall_context;
}
if (not defined $recall_nick and defined $recall_context) { $recall_nick = $recall_context; }
my ($account, $found_nick);
if (defined $recall_nick) {
($account, $found_nick) = $self->{database}->find_message_account_by_nick($recall_nick);
if (not defined $account) {
return "I don't know anybody named $recall_nick.";
}
if (not defined $account) { return "I don't know anybody named $recall_nick."; }
$found_nick =~ s/!.*$//;
}
@ -324,6 +295,7 @@ sub recall_message {
my $message;
if ($recall_history =~ /^\d+$/) {
# integral history
if (defined $account) {
my $max_messages = $self->{database}->get_max_messages($account, $recall_channel);
@ -339,11 +311,8 @@ sub recall_message {
$comma = ', ';
$count++;
}
if ($count == 0) {
return "I have no messages for $recall_nick.";
} else {
return "/say $result.";
}
if ($count == 0) { return "I have no messages for $recall_nick."; }
else { return "/say $result."; }
} else {
return "Please choose a history between 1 and $max_messages";
}
@ -353,19 +322,15 @@ sub recall_message {
$recall_history--;
$message = $self->{database}->recall_message_by_count($account, $recall_channel, $recall_history, '(?:recall|mock|ftfy|fix)');
if (not defined $message) {
return "No message found at index $recall_history in channel $recall_channel.";
}
if (not defined $message) { return "No message found at index $recall_history in channel $recall_channel."; }
} else {
# regex history
$message = $self->{database}->recall_message_by_text($account, $recall_channel, $recall_history, '(?:recall|mock|ftfy|fix)');
if (not defined $message) {
if (defined $account) {
return "No message for nick $found_nick in channel $recall_channel containing \"$recall_history\"";
} else {
return "No message in channel $recall_channel containing \"$recall_history\".";
}
if (defined $account) { return "No message for nick $found_nick in channel $recall_channel containing \"$recall_history\""; }
else { return "No message in channel $recall_channel containing \"$recall_history\"."; }
}
}
@ -374,9 +339,7 @@ sub recall_message {
if (defined $recall_context) {
($context_account) = $self->{database}->find_message_account_by_nick($recall_context);
if (not defined $context_account) {
return "I don't know anybody named $recall_context.";
}
if (not defined $context_account) { return "I don't know anybody named $recall_context."; }
}
my $messages = $self->{database}->get_message_context($message, $recall_before, $recall_after, $recall_count, $recall_history, $context_account);
@ -395,10 +358,11 @@ sub recall_message {
my $text = $msg->{msg};
my $ago = concise ago(gettimeofday - $msg->{timestamp});
if ($text =~ s/^(NICKCHANGE)\b/changed nick to/ or
$text =~ s/^(KICKED|QUIT)\b/lc "$1"/e or
$text =~ s/^MODE ([^ ]+) (.*)/set mode $1 on $2/ or
$text =~ s/^(JOIN|PART)\b/lc "$1ed"/e) {
if ( $text =~ s/^(NICKCHANGE)\b/changed nick to/
or $text =~ s/^(KICKED|QUIT)\b/lc "$1"/e
or $text =~ s/^MODE ([^ ]+) (.*)/set mode $1 on $2/
or $text =~ s/^(JOIN|PART)\b/lc "$1ed"/e)
{
$text =~ s/^(quit) (.*)/$1 ($2)/; # fix ugly "[nick] quit Quit: Leaving."
$recall_text .= "[$ago] $msg->{nick} $text\n";
} elsif ($text =~ s/^\/me\s+//) {

142
PBot/MessageHistory_SQLite.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::MessageHistory_SQLite;
use parent 'PBot::Class';
use warnings; use strict;
@ -59,7 +60,8 @@ sub begin {
$self->{pbot}->{logger}->log("Opening message history SQLite database: $self->{filename}\n");
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1 }) or die $DBI::errstr;
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
or die $DBI::errstr;
$self->{dbh}->sqlite_enable_load_extension(my $_enabled = 1);
$self->{dbh}->prepare("SELECT load_extension('/usr/lib/sqlite3/pcre.so')");
@ -212,11 +214,8 @@ sub get_current_nickserv_account {
my $sth = $self->{dbh}->prepare('SELECT nickserv FROM Accounts WHERE id = ?');
$sth->execute($id);
my $row = $sth->fetchrow_hashref();
if (defined $row) {
return $row->{'nickserv'};
} else {
return undef;
}
if (defined $row) { return $row->{'nickserv'}; }
else { return undef; }
};
$self->{pbot}->{logger}->log($@) if $@;
return $nickserv;
@ -277,9 +276,8 @@ sub add_message_account {
my $id;
my ($nick, $user, $host) = $mask =~ m/^([^!]+)!([^@]+)@(.*)/;
if (defined $link_id and $link_type == $self->{alias_type}->{STRONG}) {
$id = $link_id;
} else {
if (defined $link_id and $link_type == $self->{alias_type}->{STRONG}) { $id = $link_id; }
else {
$id = $self->get_new_account_id();
$self->{pbot}->{logger}->log("Got new account id $id\n");
}
@ -416,7 +414,8 @@ sub get_message_account {
my $link_type = $self->{alias_type}->{STRONG};
if (gettimeofday - $rows->[0]->{last_seen} > 60 * 60 * 48) {
$link_type = $self->{alias_type}->{WEAK};
$self->{pbot}->{logger}->log("Longer than 48 hours (" . concise duration(gettimeofday - $rows->[0]->{last_seen}) . ") for $rows->[0]->{hostmask} for $nick!$user\@$host, degrading to weak link\n");
$self->{pbot}->{logger}->log(
"Longer than 48 hours (" . concise duration(gettimeofday - $rows->[0]->{last_seen}) . ") for $rows->[0]->{hostmask} for $nick!$user\@$host, degrading to weak link\n");
}
$self->{pbot}->{logger}->log("6: nick-change guest match: $rows->[0]->{id}: $rows->[0]->{hostmask}\n");
$orig_nick = undef;
@ -496,6 +495,7 @@ sub get_message_account {
$self->{pbot}->{logger}->log("2: distance match: $host vs $thost == " . ($distance / $length) . "\n");
$match = 1;
} else {
# handle cases like 99.57.140.149 vs 99-57-140-149.lightspeed.sntcca.sbcglobal.net
if (defined $hostip) {
if ($hostip eq $thost) {
@ -573,7 +573,8 @@ sub get_message_account {
my $link_type = $self->{alias_type}->{STRONG};
if (gettimeofday - $rows->[0]->{last_seen} > 60 * 60 * 48) {
$link_type = $self->{alias_type}->{WEAK};
$self->{pbot}->{logger}->log("Longer than 48 hours (" . concise duration(gettimeofday - $rows->[0]->{last_seen}) . ") for $rows->[0]->{hostmask} for $nick!$user\@$host, degrading to weak link\n");
$self->{pbot}->{logger}->log(
"Longer than 48 hours (" . concise duration(gettimeofday - $rows->[0]->{last_seen}) . ") for $rows->[0]->{hostmask} for $nick!$user\@$host, degrading to weak link\n");
}
$self->{pbot}->{logger}->log("6: guest match: $rows->[0]->{id}: $rows->[0]->{hostmask}\n");
return ($rows, $link_type);
@ -631,6 +632,7 @@ sub get_message_account {
$self->{pbot}->{logger}->log("7: distance match: $host vs $thost == " . ($distance / $length) . "\n");
$match = 1;
} else {
# handle cases like 99.57.140.149 vs 99-57-140-149.lightspeed.sntcca.sbcglobal.net
if (defined $hostip) {
if ($hostip eq $thost) {
@ -663,7 +665,8 @@ sub get_message_account {
if (defined $rows->[0] and gettimeofday - $rows->[0]->{last_seen} > 60 * 60 * 48) {
$link_type = $self->{alias_type}->{WEAK};
$self->{pbot}->{logger}->log("Longer than 48 hours (" . concise duration(gettimeofday - $rows->[0]->{last_seen}) . ") for $rows->[0]->{hostmask} for $nick!$user\@$host, degrading to weak link\n");
$self->{pbot}->{logger}->log(
"Longer than 48 hours (" . concise duration(gettimeofday - $rows->[0]->{last_seen}) . ") for $rows->[0]->{hostmask} for $nick!$user\@$host, degrading to weak link\n");
}
=cut
@ -671,10 +674,9 @@ sub get_message_account {
$self->{pbot}->{logger}->log("Found matching user\@host mask $row->{hostmask} with id $row->{id}\n");
}
=cut
}
if (defined $rows->[0]) {
$self->{pbot}->{logger}->log("10: matching *!user\@host: $rows->[0]->{id}: $rows->[0]->{hostmask}\n");
}
if (defined $rows->[0]) { $self->{pbot}->{logger}->log("10: matching *!user\@host: $rows->[0]->{id}: $rows->[0]->{hostmask}\n"); }
return ($rows, $link_type);
};
@ -684,12 +686,15 @@ sub get_message_account {
if (defined $rows->[0] and not defined $orig_nick) {
if ($link_type == $self->{alias_type}->{STRONG}) {
my $host1 = lc "$nick!$user\@$host";
my $host2 = lc $rows->[0]->{hostmask};
my ($nick1) = $host1 =~ m/^([^!]+)!/;
my ($nick2) = $host2 =~ m/^([^!]+)!/;
my $distance = fastdistance($nick1, $nick2);
my $length = (length $nick1 > length $nick2) ? length $nick1 : length $nick2;
if ($distance > 1 && ($nick1 !~ /^guest/ && $nick2 !~ /^guest/) && ($host1 !~ /unaffiliated/ || $host2 !~ /unaffiliated/)) {
my $id = $rows->[0]->{id};
$self->{pbot}->{logger}->log("[$nick1][$nick2] $distance / $length\n");
@ -697,7 +702,9 @@ sub get_message_account {
}
}
$self->{pbot}->{logger}->log("message-history: [get-account] $nick!$user\@$host " . ($link_type == $self->{alias_type}->{WEAK} ? "weakly linked to" : "added to account") . " $rows->[0]->{hostmask} with id $rows->[0]->{id}\n");
$self->{pbot}->{logger}->log("message-history: [get-account] $nick!$user\@$host "
. ($link_type == $self->{alias_type}->{WEAK} ? "weakly linked to" : "added to account")
. " $rows->[0]->{hostmask} with id $rows->[0]->{id}\n");
$self->add_message_account("$nick!$user\@$host", $rows->[0]->{id}, $link_type);
$self->devalidate_all_channels($rows->[0]->{id});
$self->update_hostmask_data("$nick!$user\@$host", {last_seen => scalar gettimeofday});
@ -742,9 +749,7 @@ sub update_hostmask_data {
my $sth = $self->{dbh}->prepare($sql);
my $param = 1;
foreach my $key (keys %$data) {
$sth->bind_param($param++, $data->{$key});
}
foreach my $key (keys %$data) { $sth->bind_param($param++, $data->{$key}); }
$sth->bind_param($param, $mask);
$sth->execute();
@ -833,11 +838,8 @@ sub get_recent_messages {
my $sql = "SELECT msg, mode, timestamp FROM Messages WHERE ";
my %akas;
if (defined $mode and $mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) {
%akas = $self->get_also_known_as($nick);
} else {
$akas{'this'} = { id => $id, type => $self->{alias_type}->{STRONG}, nickchange => 0 };
}
if (defined $mode and $mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { %akas = $self->get_also_known_as($nick); }
else { $akas{'this'} = {id => $id, type => $self->{alias_type}->{STRONG}, nickchange => 0}; }
my $ids;
my %seen_id;
@ -923,14 +925,16 @@ sub get_message_context {
$messages_count = eval {
my $sth;
if (defined $context_id) {
$sth = $self->{dbh}->prepare('SELECT id, msg, mode, timestamp, channel FROM Messages WHERE id = ? AND channel = ? AND msg REGEXP ? AND timestamp < ? AND mode = 0 ORDER BY timestamp DESC LIMIT ?');
$sth = $self->{dbh}->prepare(
'SELECT id, msg, mode, timestamp, channel FROM Messages WHERE id = ? AND channel = ? AND msg REGEXP ? AND timestamp < ? AND mode = 0 ORDER BY timestamp DESC LIMIT ?');
$sth->bind_param(1, $context_id);
$sth->bind_param(2, $message->{channel});
$sth->bind_param(3, $regex);
$sth->bind_param(4, $message->{timestamp});
$sth->bind_param(5, $count - 1);
} else {
$sth = $self->{dbh}->prepare('SELECT id, msg, mode, timestamp, channel FROM Messages WHERE channel = ? AND msg REGEXP ? AND timestamp < ? AND mode = 0 ORDER BY timestamp DESC LIMIT ?');
$sth = $self->{dbh}
->prepare('SELECT id, msg, mode, timestamp, channel FROM Messages WHERE channel = ? AND msg REGEXP ? AND timestamp < ? AND mode = 0 ORDER BY timestamp DESC LIMIT ?');
$sth->bind_param(1, $message->{channel});
$sth->bind_param(2, $regex);
$sth->bind_param(3, $message->{timestamp});
@ -946,7 +950,8 @@ sub get_message_context {
$messages_before = eval {
my $sth;
if (defined $context_id) {
$sth = $self->{dbh}->prepare('SELECT id, msg, mode, timestamp, channel FROM Messages WHERE id = ? AND channel = ? AND timestamp < ? AND mode = 0 ORDER BY timestamp DESC LIMIT ?');
$sth = $self->{dbh}
->prepare('SELECT id, msg, mode, timestamp, channel FROM Messages WHERE id = ? AND channel = ? AND timestamp < ? AND mode = 0 ORDER BY timestamp DESC LIMIT ?');
$sth->bind_param(1, $context_id);
$sth->bind_param(2, $message->{channel});
$sth->bind_param(3, $message->{timestamp});
@ -967,7 +972,8 @@ sub get_message_context {
$messages_after = eval {
my $sth;
if (defined $context_id) {
$sth = $self->{dbh}->prepare('SELECT id, msg, mode, timestamp, channel FROM Messages WHERE id = ? AND channel = ? AND timestamp > ? AND mode = 0 ORDER BY timestamp ASC LIMIT ?');
$sth = $self->{dbh}
->prepare('SELECT id, msg, mode, timestamp, channel FROM Messages WHERE id = ? AND channel = ? AND timestamp > ? AND mode = 0 ORDER BY timestamp ASC LIMIT ?');
$sth->bind_param(1, $context_id);
$sth->bind_param(2, $message->{channel});
$sth->bind_param(3, $message->{timestamp});
@ -1105,7 +1111,10 @@ sub recall_message_by_text {
my $bot_trigger = $self->{pbot}->{registry}->get_value('general', 'trigger');
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
foreach my $message (@$messages) {
next if $message->{msg} =~ m/^$botnick.? $ignore_command/i or $message->{msg} =~ m/^(?:\s*[^,:\(\)\+\*\/ ]+[,:]?\s+)?$bot_trigger$ignore_command/i or $message->{msg} =~ m/^\s*$ignore_command.? $botnick$/i;
next
if $message->{msg} =~ m/^$botnick.? $ignore_command/i
or $message->{msg} =~ m/^(?:\s*[^,:\(\)\+\*\/ ]+[,:]?\s+)?$bot_trigger$ignore_command/i
or $message->{msg} =~ m/^\s*$ignore_command.? $botnick$/i;
return $message;
}
return undef;
@ -1120,11 +1129,8 @@ sub get_max_messages {
my $sql = "SELECT COUNT(*) FROM Messages WHERE channel = ? AND ";
my %akas;
if (defined $use_aliases) {
%akas = $self->get_also_known_as($use_aliases);
} else {
$akas{'this'} = { id => $id, type => $self->{alias_type}->{STRONG}, nickchange => 0 };
}
if (defined $use_aliases) { %akas = $self->get_also_known_as($use_aliases); }
else { $akas{'this'} = {id => $id, type => $self->{alias_type}->{STRONG}, nickchange => 0}; }
my $ids;
my %seen_id;
@ -1196,9 +1202,8 @@ sub get_channel_data {
my $channel_data = eval {
my $sql = 'SELECT ';
if (not @columns) {
$sql .= '*';
} else {
if (not @columns) { $sql .= '*'; }
else {
my $comma = '';
foreach my $column (@columns) {
$sql .= "$comma$column";
@ -1234,9 +1239,7 @@ sub update_channel_data {
my $sth = $self->{dbh}->prepare($sql);
my $param = 1;
foreach my $key (keys %$data) {
$sth->bind_param($param++, $data->{$key});
}
foreach my $key (keys %$data) { $sth->bind_param($param++, $data->{$key}); }
$sth->bind_param($param++, $id);
$sth->bind_param($param, $channel);
@ -1371,6 +1374,7 @@ sub link_aliases {
$ids{$row->{id}} = {id => $row->{id}, type => $self->{alias_type}->{STRONG}}; # don't force linking
$self->{pbot}->{logger}->log("found STRONG matching id $row->{id} ($row->{hostmask}) for nick [$nick]\n") if $debug_link >= 2;
} else {
# handle cases like 99.57.140.149 vs 99-57-140-149.lightspeed.sntcca.sbcglobal.net
if (defined $hostip) {
if ($hostip eq $thost) {
@ -1415,7 +1419,9 @@ sub link_alias {
my $debug_link = $self->{pbot}->{registry}->get_value('messagehistory', 'debug_link');
$self->{pbot}->{logger}->log("Attempting to " . ($force ? "forcefully " : "") . ($type == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " link $id to $alias\n") if $debug_link >= 3;
$self->{pbot}->{logger}
->log("Attempting to " . ($force ? "forcefully " : "") . ($type == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " link $id to $alias\n")
if $debug_link >= 3;
my $ret = eval {
my $sth = $self->{dbh}->prepare('SELECT type FROM Aliases WHERE id = ? AND alias = ? LIMIT 1');
@ -1426,18 +1432,21 @@ sub link_alias {
if (defined $row) {
if ($force) {
if ($row->{'type'} != $type) {
$self->{pbot}->{logger}->log("$id already " . ($row->{'type'} == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " linked to $alias, forcing override\n") if $debug_link >= 1;
$self->{pbot}->{logger}->log("$id already " . ($row->{'type'} == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " linked to $alias, forcing override\n")
if $debug_link >= 1;
$sth = $self->{dbh}->prepare('UPDATE Aliases SET type = ? WHERE alias = ? AND id = ?');
$sth->execute($type, $id, $alias);
$sth->execute($type, $alias, $id);
return 1;
} else {
$self->{pbot}->{logger}->log("$id already " . ($row->{'type'} == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " linked to $alias, ignoring\n") if $debug_link >= 4;
$self->{pbot}->{logger}->log("$id already " . ($row->{'type'} == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " linked to $alias, ignoring\n")
if $debug_link >= 4;
return 0;
}
} else {
$self->{pbot}->{logger}->log("$id already " . ($row->{'type'} == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " linked to $alias, ignoring\n") if $debug_link >= 4;
$self->{pbot}->{logger}->log("$id already " . ($row->{'type'} == $self->{alias_type}->{STRONG} ? "strongly" : "weakly") . " linked to $alias, ignoring\n")
if $debug_link >= 4;
return 0;
}
}
@ -1498,9 +1507,7 @@ sub unlink_alias {
sub vacuum {
my $self = shift;
eval {
$self->{dbh}->commit();
};
eval { $self->{dbh}->commit(); };
$self->{pbot}->{logger}->log("SQLite error $@ when committing $self->{new_entries} entries.\n") if $@;
@ -1531,9 +1538,7 @@ sub rebuild_aliases_table {
$sth->execute($row->{id});
my $nrows = $sth->fetchall_arrayref({});
foreach my $nrow (@$nrows) {
$self->link_aliases($row->{id}, undef, $nrow->{nickserv});
}
foreach my $nrow (@$nrows) { $self->link_aliases($row->{id}, undef, $nrow->{nickserv}); }
}
};
@ -1552,9 +1557,7 @@ sub get_also_known_as {
unless ($dont_use_aliases_table) {
my ($id, $hostmask) = $self->find_message_account_by_nick($nick);
if (not defined $id) {
return %akas;
}
if (not defined $id) { return %akas; }
$ids{$id} = {id => $id, type => $self->{alias_type}->{STRONG}};
$self->{pbot}->{logger}->log("Adding $id -> $id\n") if $debug;
@ -1564,6 +1567,7 @@ sub get_also_known_as {
my $rows = $sth->fetchall_arrayref({});
foreach my $row (@$rows) {
# next if $row->{type} == $self->{alias_type}->{WEAK};
$ids{$row->{alias}} = {id => $id, type => $row->{type}};
$self->{pbot}->{logger}->log("[$id] 1) Adding $row->{alias} -> $id [type $row->{type}]\n") if $debug;
@ -1584,6 +1588,7 @@ sub get_also_known_as {
foreach my $row (@$rows) {
next if exists $ids{$row->{id}};
#next if $row->{type} == $self->{alias_type}->{WEAK};
$ids{$row->{id}} = {id => $id, type => $ids{$id}->{type} == $self->{alias_type}->{WEAK} ? $self->{alias_type}->{WEAK} : $row->{type}};
$new_aliases++;
@ -1614,11 +1619,8 @@ sub get_also_known_as {
foreach my $row (@$rows) {
foreach my $aka (keys %akas) {
if ($akas{$aka}->{id} == $id) {
if (exists $akas{$aka}->{nickserv}) {
$akas{$aka}->{nickserv} .= ",$row->{nickserv}";
} else {
$akas{$aka}->{nickserv} = $row->{nickserv};
}
if (exists $akas{$aka}->{nickserv}) { $akas{$aka}->{nickserv} .= ",$row->{nickserv}"; }
else { $akas{$aka}->{nickserv} = $row->{nickserv}; }
}
}
}
@ -1687,19 +1689,14 @@ sub get_also_known_as {
$sth->execute($id);
$rows = $sth->fetchall_arrayref({});
foreach my $row (@$rows) {
$nickservs{$row->{nickserv}} = $id;
}
foreach my $row (@$rows) { $nickservs{$row->{nickserv}} = $id; }
}
foreach my $nickserv (sort keys %nickservs) {
foreach my $aka (keys %akas) {
if ($akas{$aka}->{id} == $nickservs{$nickserv}) {
if (exists $akas{$aka}->{nickserv}) {
$akas{$aka}->{nickserv} .= ",$nickserv";
} else {
$akas{$aka}->{nickserv} = $nickserv;
}
if (exists $akas{$aka}->{nickserv}) { $akas{$aka}->{nickserv} .= ",$nickserv"; }
else { $akas{$aka}->{nickserv} = $nickserv; }
}
}
@ -1717,11 +1714,8 @@ sub get_also_known_as {
foreach my $nrow (@$rows) {
if (exists $akas{$nrow->{hostmask}}) {
if (exists $akas{$nrow->{hostmask}}->{nickserv}) {
$akas{$nrow->{hostmask}}->{nickserv} .= ",$nickserv";
} else {
$akas{$nrow->{hostmask}}->{nickserv} = $nickserv;
}
if (exists $akas{$nrow->{hostmask}}->{nickserv}) { $akas{$nrow->{hostmask}}->{nickserv} .= ",$nickserv"; }
else { $akas{$nrow->{hostmask}}->{nickserv} = $nickserv; }
} else {
$akas{$nrow->{hostmask}} = {hostmask => $nrow->{hostmask}, id => $row->{id}, nickserv => $nickserv};
$self->{pbot}->{logger}->log("Adding matching nickserv [$nickserv] and id [$row->{id}] AKA hostmask $nrow->{hostmask}\n");
@ -1794,6 +1788,7 @@ sub get_message_account_id {
};
$self->{pbot}->{logger}->log($@) if $@;
#$self->{pbot}->{logger}->log("get_message_account_id: returning id [". (defined $id ? $id: 'undef') . "] for mask [$mask]\n");
return $id;
}
@ -1804,10 +1799,9 @@ sub commit_message_history {
return if not $self->{dbh};
if ($self->{new_entries} > 0) {
# $self->{pbot}->{logger}->log("Commiting $self->{new_entries} messages to SQLite\n");
eval {
$self->{dbh}->commit();
};
eval { $self->{dbh}->commit(); };
$self->{pbot}->{logger}->log("SQLite error $@ when committing $self->{new_entries} entries.\n") if $@;

24
PBot/Modules.pm
View File

@ -6,6 +6,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::Modules;
use parent 'PBot::Class';
use warnings; use strict;
@ -26,9 +27,7 @@ sub load_cmd {
my ($keyword, $module) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
return "Usage: load <keyword> <module>" if not defined $module;
if ($factoids->exists('.*', $keyword)) {
return 'There is already a keyword named ' . $factoids->get_data('.*', $keyword, '_name') . '.';
}
if ($factoids->exists('.*', $keyword)) { return 'There is already a keyword named ' . $factoids->get_data('.*', $keyword, '_name') . '.'; }
$self->{pbot}->{factoids}->add_factoid('module', '.*', "$nick!$user\@$host", $keyword, $module, 1);
$factoids->set('.*', $keyword, 'add_nick', 1, 1);
@ -44,9 +43,7 @@ sub unload_cmd {
my $factoids = $self->{pbot}->{factoids}->{factoids};
return "/say $module not found." if not $factoids->exists('.*', $module);
if ($factoids->get_data('.*', $module, 'type') ne 'module') {
return "/say " . $factoids->get_data('.*', $module, '_name') . ' is not a module.';
}
if ($factoids->get_data('.*', $module, 'type') ne 'module') { return "/say " . $factoids->get_data('.*', $module, '_name') . ' is not a module.'; }
my $name = $factoids->get_data('.*', $module, '_name');
$factoids->remove('.*', $module);
@ -84,7 +81,9 @@ sub launch_module {
$stuff->{trigger} = $trigger;
my $module = $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, 'action');
$self->{pbot}->{logger}->log("(" . (defined $stuff->{from} ? $stuff->{from} : "(undef)") . "): $stuff->{nick}!$stuff->{user}\@$stuff->{host}: Executing module [$stuff->{command}] $module $stuff->{arguments}\n");
$self->{pbot}->{logger}->log("("
. (defined $stuff->{from} ? $stuff->{from} : "(undef)")
. "): $stuff->{nick}!$stuff->{user}\@$stuff->{host}: Executing module [$stuff->{command}] $module $stuff->{arguments}\n");
$stuff->{arguments} = $self->{pbot}->{factoids}->expand_special_vars($stuff->{from}, $stuff->{nick}, $stuff->{root_keyword}, $stuff->{arguments});
my $module_dir = $self->{pbot}->{registry}->get_value('general', 'module_dir');
@ -100,9 +99,7 @@ sub launch_module {
# FIXME -- add check to ensure $module exists
my ($exitval, $stdout, $stderr) = eval {
my $args = $stuff->{arguments};
if (not $stuff->{args_utf8}) {
$args = encode('UTF-8', $args);
}
if (not $stuff->{args_utf8}) { $args = encode('UTF-8', $args); }
my @cmdline = ("./$module", $self->{pbot}->{interpreter}->split_line($args));
my $timeout = $self->{pbot}->{registry}->get_value('general', 'module_timeout') // 30;
my ($stdin, $stdout, $stderr);
@ -115,11 +112,8 @@ sub launch_module {
if ($@) {
my $error = $@;
if ($error =~ m/timeout on timer/) {
($exitval, $stdout, $stderr) = (-1, "$stuff->{trigger}: timed-out", '');
} else {
($exitval, $stdout, $stderr) = (-1, '', $error);
}
if ($error =~ m/timeout on timer/) { ($exitval, $stdout, $stderr) = (-1, "$stuff->{trigger}: timed-out", ''); }
else { ($exitval, $stdout, $stderr) = (-1, '', $error); }
}
if (length $stderr) {

68
PBot/NickList.pm
View File

@ -10,6 +10,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::NickList;
use parent 'PBot::Class';
use warnings; use strict;
@ -17,6 +18,7 @@ use feature 'unicode_strings';
use Text::Levenshtein qw/fastdistance/;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
use Time::HiRes qw/gettimeofday/;
@ -49,16 +51,11 @@ sub show_nicklist {
my @args = split / /, $arguments;
if (@args == 1) {
if (not exists $self->{nicklist}->{lc $arguments}) {
return "No nicklist for $arguments.";
}
if (not exists $self->{nicklist}->{lc $arguments}) { return "No nicklist for $arguments."; }
$nicklist = Dumper($self->{nicklist}->{lc $arguments});
} else {
if (not exists $self->{nicklist}->{lc $args[0]}) {
return "No nicklist for $args[0].";
} elsif (not exists $self->{nicklist}->{lc $args[0]}->{lc $args[1]}) {
return "No such nick $args[1] in channel $args[0].";
}
if (not exists $self->{nicklist}->{lc $args[0]}) { return "No nicklist for $args[0]."; }
elsif (not exists $self->{nicklist}->{lc $args[0]}->{lc $args[1]}) { return "No such nick $args[1] in channel $args[0]."; }
$nicklist = Dumper($self->{nicklist}->{lc $args[0]}->{lc $args[1]});
}
return $nicklist;
@ -70,9 +67,8 @@ sub update_timestamp {
$channel = lc $channel;
$nick = lc $nick;
if (exists $self->{nicklist}->{$channel} and exists $self->{nicklist}->{$channel}->{$nick}) {
$self->{nicklist}->{$channel}->{$nick}->{timestamp} = gettimeofday;
} else {
if (exists $self->{nicklist}->{$channel} and exists $self->{nicklist}->{$channel}->{$nick}) { $self->{nicklist}->{$channel}->{$nick}->{timestamp} = gettimeofday; }
else {
$self->{pbot}->{logger}->log("Adding nick '$orig_nick' to channel '$channel'\n") if $self->{pbot}->{registry}->get_value('nicklist', 'debug');
$self->{nicklist}->{$channel}->{$nick} = {nick => $orig_nick, timestamp => scalar gettimeofday};
}
@ -104,9 +100,7 @@ sub get_channels {
$nick = lc $nick;
foreach my $channel (keys %{$self->{nicklist}}) {
if (exists $self->{nicklist}->{$channel}->{$nick}) {
push @channels, $channel;
}
if (exists $self->{nicklist}->{$channel}->{$nick}) { push @channels, $channel; }
}
return \@channels;
@ -117,9 +111,7 @@ sub get_nicks {
$channel = lc $channel;
my @nicks;
return @nicks if not exists $self->{nicklist}->{$channel};
foreach my $nick (keys %{ $self->{nicklist}->{$channel} }) {
push @nicks, $self->{nicklist}->{$channel}->{$nick}->{nick};
}
foreach my $nick (keys %{$self->{nicklist}->{$channel}}) { push @nicks, $self->{nicklist}->{$channel}->{$nick}->{nick}; }
return @nicks;
}
@ -159,9 +151,7 @@ sub delete_meta {
$channel = lc $channel;
$nick = lc $nick;
if (not exists $self->{nicklist}->{$channel}
or not exists $self->{nicklist}->{$channel}->{$nick}
or not exists $self->{nicklist}->{$channel}->{$nick}->{$key}) {
if (not exists $self->{nicklist}->{$channel} or not exists $self->{nicklist}->{$channel}->{$nick} or not exists $self->{nicklist}->{$channel}->{$nick}->{$key}) {
return undef;
}
return delete $self->{nicklist}->{$channel}->{$nick}->{$key};
@ -173,9 +163,7 @@ sub get_meta {
$channel = lc $channel;
$nick = lc $nick;
if (not exists $self->{nicklist}->{$channel}
or not exists $self->{nicklist}->{$channel}->{$nick}
or not exists $self->{nicklist}->{$channel}->{$nick}->{$key}) {
if (not exists $self->{nicklist}->{$channel} or not exists $self->{nicklist}->{$channel}->{$nick} or not exists $self->{nicklist}->{$channel}->{$nick}->{$key}) {
return undef;
}
@ -188,9 +176,7 @@ sub is_present_any_channel {
$nick = lc $nick;
foreach my $channel (keys %{$self->{nicklist}}) {
if (exists $self->{nicklist}->{$channel}->{$nick}) {
return $self->{nicklist}->{$channel}->{$nick}->{nick};
}
if (exists $self->{nicklist}->{$channel}->{$nick}) { return $self->{nicklist}->{$channel}->{$nick}->{nick}; }
}
return 0;
}
@ -201,11 +187,8 @@ sub is_present {
$channel = lc $channel;
$nick = lc $nick;
if (exists $self->{nicklist}->{$channel} and exists $self->{nicklist}->{$channel}->{$nick}) {
return $self->{nicklist}->{$channel}->{$nick}->{nick};
} else {
return 0;
}
if (exists $self->{nicklist}->{$channel} and exists $self->{nicklist}->{$channel}->{$nick}) { return $self->{nicklist}->{$channel}->{$nick}->{nick}; }
else { return 0; }
}
sub is_present_similar {
@ -224,14 +207,13 @@ sub is_present_similar {
$percentage = $similar if defined $similar;
my $now = gettimeofday;
foreach my $person (sort { $self->{nicklist}->{$channel}->{$b}->{timestamp} <=> $self->{nicklist}->{$channel}->{$a}->{timestamp} } keys %{ $self->{nicklist}->{$channel} }) {
foreach my $person (sort { $self->{nicklist}->{$channel}->{$b}->{timestamp} <=> $self->{nicklist}->{$channel}->{$a}->{timestamp} } keys %{$self->{nicklist}->{$channel}})
{
return 0 if $now - $self->{nicklist}->{$channel}->{$person}->{timestamp} > 3600; # 1 hour
my $distance = fastdistance($nick, $person);
my $length = length $nick > length $person ? length $nick : length $person;
if ($length != 0 && $distance / $length <= $percentage) {
return $self->{nicklist}->{$channel}->{$person}->{nick};
}
if ($length != 0 && $distance / $length <= $percentage) { return $self->{nicklist}->{$channel}->{$person}->{nick}; }
}
return 0;
}
@ -270,17 +252,11 @@ sub on_namreply {
$self->set_meta($channel, $stripped_nick, 'host', $host);
}
if ($nick =~ m/\@/) {
$self->set_meta($channel, $stripped_nick, '+o', 1);
}
if ($nick =~ m/\@/) { $self->set_meta($channel, $stripped_nick, '+o', 1); }
if ($nick =~ m/\+/) {
$self->set_meta($channel, $stripped_nick, '+v', 1);
}
if ($nick =~ m/\+/) { $self->set_meta($channel, $stripped_nick, '+v', 1); }
if ($nick =~ m/\%/) {
$self->set_meta($channel, $stripped_nick, '+h', 1);
}
if ($nick =~ m/\%/) { $self->set_meta($channel, $stripped_nick, '+h', 1); }
}
return 0;
}
@ -314,9 +290,7 @@ sub on_quit {
my ($nick, $user, $host) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host);
foreach my $channel (keys %{$self->{nicklist}}) {
if ($self->is_present($channel, $nick)) {
$self->remove_nick($channel, $nick);
}
if ($self->is_present($channel, $nick)) { $self->remove_nick($channel, $nick); }
}
return 0;
}

44
PBot/PBot.pm
View File

@ -179,9 +179,7 @@ sub initialize {
$self->{registry}->set_default('irc', 'identify_password', 'private', 1);
# load existing registry entries from file (if exists) to overwrite defaults
if (-e $self->{registry}->{registry}->{filename}) {
$self->{registry}->load;
}
if (-e $self->{registry}->{registry}->{filename}) { $self->{registry}->load; }
# update important paths
$self->{registry}->set('general', 'data_dir', 'value', $data_dir, 0, 1);
@ -255,6 +253,7 @@ sub connect {
my ($self, $server) = @_;
if ($self->{connected}) {
# TODO: disconnect, clean-up, etc
}
@ -262,7 +261,8 @@ sub connect {
$self->{logger}->log("Connecting to $server ...\n");
while (not $self->{conn} = $self->{irc}->newconn(
while (
not $self->{conn} = $self->{irc}->newconn(
Nick => $self->{registry}->get_value('irc', 'randomize_nick') ? $self->random_nick : $self->{registry}->get_value('irc', 'botnick'),
Username => $self->{registry}->get_value('irc', 'username'),
Ircname => $self->{registry}->get_value('irc', 'realname'),
@ -272,7 +272,10 @@ sub connect {
SSL => $self->{registry}->get_value('irc', 'SSL'),
SSL_ca_file => $self->{registry}->get_value('irc', 'SSL_ca_file'),
SSL_ca_path => $self->{registry}->get_value('irc', 'SSL_ca_path'),
Port => $self->{registry}->get_value('irc', 'port'))) {
Port => $self->{registry}->get_value('irc', 'port')
)
)
{
$self->{logger}->log("$0: Can't connect to $server:" . $self->{registry}->get_value('irc', 'port') . ". Retrying in 15 seconds...\n");
sleep 15;
}
@ -287,14 +290,19 @@ sub connect {
$self->{conn}->add_handler([251, 252, 253, 254, 255, 302], sub { $self->{irchandlers}->on_init(@_) });
# ignore these events
$self->{conn}->add_handler(['whoisserver',
$self->{conn}->add_handler(
[
'whoisserver',
'whoiscountry',
'whoischannels',
'whoisidle',
'motdstart',
'endofmotd',
'away',
'endofbanlist'], sub {});
'endofbanlist'
],
sub { }
);
}
#main loop
@ -340,9 +348,7 @@ sub listcmd {
my $usage = "Usage: list <modules|commands>";
if (not defined $arguments) {
return $usage;
}
if (not defined $arguments) { return $usage; }
if ($arguments =~ /^modules$/i) {
$text = "Loaded modules: ";
@ -360,11 +366,8 @@ sub listcmd {
if ($arguments =~ /^commands$/i) {
$text = "Registered commands: ";
foreach my $command (sort { $a->{name} cmp $b->{name} } @{$self->{commands}->{handlers}}) {
if ($command->{requires_cap}) {
$text .= "+$command->{name} ";
} else {
$text .= "$command->{name} ";
}
if ($command->{requires_cap}) { $text .= "+$command->{name} "; }
else { $text .= "$command->{name} "; }
}
return $text;
}
@ -395,9 +398,7 @@ sub export {
return "Usage: export <factoids>" if not defined $arguments;
if ($arguments =~ /^factoids$/i) {
return $self->{factoids}->export_factoids;
}
if ($arguments =~ /^factoids$/i) { return $self->{factoids}->export_factoids; }
}
sub evalcmd {
@ -408,11 +409,8 @@ sub evalcmd {
my $ret = '';
my $result = eval $arguments;
if ($@) {
if (length $result) {
$ret .= "[Error: $@] ";
} else {
$ret .= "Error: $@";
}
if (length $result) { $ret .= "[Error: $@] "; }
else { $ret .= "Error: $@"; }
$ret =~ s/ at \(eval \d+\) line 1.//;
}
$result = 'Undefined.' if not defined $result;

28
PBot/Plugins.pm
View File

@ -50,7 +50,7 @@ sub autoload {
# do not load plugins that begin with a comment
next if $plugin =~ m/^\s*#/;
$plugin_count++ if $self->load($plugin, %conf)
$plugin_count++ if $self->load($plugin, %conf);
}
$self->{pbot}->{logger}->log("$plugin_count plugin" . ($plugin_count == 1 ? '' : 's') . " loaded.\n");
}
@ -124,9 +124,7 @@ sub unload {
sub reload_cmd {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
if (not length $arguments) {
return "Usage: replug <plugin>";
}
if (not length $arguments) { return "Usage: replug <plugin>"; }
my $unload_result = $self->unload_cmd($from, $nick, $user, $host, $arguments);
my $load_result = $self->load_cmd($from, $nick, $user, $host, $arguments);
@ -140,29 +138,19 @@ sub reload_cmd {
sub load_cmd {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
if (not length $arguments) {
return "Usage: plug <plugin>";
}
if (not length $arguments) { return "Usage: plug <plugin>"; }
if ($self->load($arguments)) {
return "Loaded $arguments plugin.";
} else {
return "Plugin $arguments failed to load.";
}
if ($self->load($arguments)) { return "Loaded $arguments plugin."; }
else { return "Plugin $arguments failed to load."; }
}
sub unload_cmd {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
if (not length $arguments) {
return "Usage: unplug <plugin>";
}
if (not length $arguments) { return "Usage: unplug <plugin>"; }
if ($self->unload($arguments)) {
return "Unloaded $arguments plugin.";
} else {
return "Plugin $arguments is not loaded.";
}
if ($self->unload($arguments)) { return "Unloaded $arguments plugin."; }
else { return "Plugin $arguments is not loaded."; }
}
sub list_cmd {

49
PBot/ProcessManager.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::ProcessManager;
use parent 'PBot::Class';
use warnings; use strict;
@ -24,20 +25,17 @@ sub initialize {
$self->{processes} = {};
# automatically reap children processes in background
$SIG{CHLD} = sub { my $pid; do { $pid = waitpid(-1, WNOHANG); $self->remove_process($pid) if $pid > 0; } while $pid > 0; };
$SIG{CHLD} = sub {
my $pid; do { $pid = waitpid(-1, WNOHANG); $self->remove_process($pid) if $pid > 0; } while $pid > 0;
};
}
sub ps_cmd {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
my @processes;
foreach my $pid (sort keys %{$self->{processes}}) {
push @processes, "$pid: $self->{processes}->{$pid}->{commands}->[0]";
}
if (@processes) {
return "Running processes: " . join '; ', @processes;
} else {
return "No running processes.";
}
foreach my $pid (sort keys %{$self->{processes}}) { push @processes, "$pid: $self->{processes}->{$pid}->{commands}->[0]"; }
if (@processes) { return "Running processes: " . join '; ', @processes; }
else { return "No running processes."; }
}
sub kill_cmd {
@ -68,9 +66,7 @@ sub execute_process {
my ($self, $stuff, $subref, $timeout) = @_;
$timeout //= 30;
if (not exists $stuff->{commands}) {
$stuff->{commands} = [ $stuff->{command} ];
}
if (not exists $stuff->{commands}) { $stuff->{commands} = [$stuff->{command}]; }
pipe(my $reader, my $writer);
$stuff->{pid} = fork;
@ -85,6 +81,7 @@ sub execute_process {
}
if ($stuff->{pid} == 0) {
# child
close $reader;
@ -119,10 +116,12 @@ sub execute_process {
# end child
exit 0;
} else {
# parent
close $writer;
$self->add_process($stuff->{pid}, $stuff);
$self->{pbot}->{select_handler}->add_reader($reader, sub { $self->process_pipe_reader($stuff->{pid}, @_) });
# return empty string since reader will handle the output when child is finished
return "";
}
@ -140,9 +139,7 @@ sub process_pipe_reader {
return;
}
if ($stuff->{referenced}) {
return if $stuff->{result} =~ m/(?:no results)/i;
}
if ($stuff->{referenced}) { return if $stuff->{result} =~ m/(?:no results)/i; }
if (exists $stuff->{special} and $stuff->{special} eq 'code-factoid') {
$stuff->{result} =~ s/\s+$//g;
@ -153,27 +150,35 @@ sub process_pipe_reader {
$stuff->{checkflood} = 0;
if (defined $stuff->{nickoverride}) {
$self->{pbot}->{interpreter}->handle_result($stuff, $stuff->{result});
} else {
if (defined $stuff->{nickoverride}) { $self->{pbot}->{interpreter}->handle_result($stuff, $stuff->{result}); }
else {
# don't override nick if already set
if (exists $stuff->{special} and $stuff->{special} ne 'code-factoid' and $self->{pbot}->{factoids}->{factoids}->exists($stuff->{channel}, $stuff->{trigger}, 'add_nick') and $self->{pbot}->{factoids}->{factoids}->get_data($stuff->{channel}, $stuff->{trigger}, 'add_nick') != 0) {
if ( exists $stuff->{special}
and $stuff->{special} ne 'code-factoid'
and $self->{pbot}->{factoids}->{factoids}->exists($stuff->{channel}, $stuff->{trigger}, 'add_nick')
and $self->{pbot}->{factoids}->{factoids}->get_data($stuff->{channel}, $stuff->{trigger}, 'add_nick') != 0)
{
$stuff->{nickoverride} = $stuff->{nick};
$stuff->{no_nickoverride} = 0;
$stuff->{force_nickoverride} = 1;
} else {
# extract nick-like thing from module result
if ($stuff->{result} =~ s/^(\S+): //) {
my $nick = $1;
if (lc $nick eq "usage") {
# put it back on result if it's a usage message
$stuff->{result} = "$nick: $stuff->{result}";
} else {
my $present = $self->{pbot}->{nicklist}->is_present($stuff->{channel}, $nick);
if ($present) {
# nick is present in channel
$stuff->{nickoverride} = $present;
} else {
# nick not present, put it back on result
$stuff->{result} = "$nick: $stuff->{result}";
}
@ -183,8 +188,10 @@ sub process_pipe_reader {
$self->{pbot}->{interpreter}->handle_result($stuff, $stuff->{result});
}
my $text = $self->{pbot}->{interpreter}->truncate_result($stuff->{channel}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), 'undef', $stuff->{result}, $stuff->{result}, 0);
$self->{pbot}->{antiflood}->check_flood($stuff->{from}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), $self->{pbot}->{registry}->get_value('irc', 'username'), 'pbot', $text, 0, 0, 0);
my $text = $self->{pbot}->{interpreter}
->truncate_result($stuff->{channel}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), 'undef', $stuff->{result}, $stuff->{result}, 0);
$self->{pbot}->{antiflood}
->check_flood($stuff->{from}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), $self->{pbot}->{registry}->get_value('irc', 'username'), 'pbot', $text, 0, 0, 0);
}
1;

4
PBot/Registerable.pm
View File

@ -41,9 +41,7 @@ sub execute {
my $ref = shift;
Carp::croak("Missing reference parameter to Registerable::execute") if not defined $ref;
foreach my $func (@{$self->{handlers}}) {
if ($ref == $func || $ref == $func->{subref}) {
return &{ $func->{subref} }(@_);
}
if ($ref == $func || $ref == $func->{subref}) { return &{$func->{subref}}(@_); }
}
return undef;
}

36
PBot/Registry.pm
View File

@ -9,6 +9,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::Registry;
use parent 'PBot::Class';
use warnings; use strict;
@ -30,9 +31,7 @@ sub load {
my $self = shift;
$self->{registry}->load;
foreach my $section ($self->{registry}->get_keys) {
foreach my $item ($self->{registry}->get_keys($section)) {
$self->process_trigger($section, $item, $self->{registry}->get_data($section, $item, 'value'));
}
foreach my $item ($self->{registry}->get_keys($section)) { $self->process_trigger($section, $item, $self->{registry}->get_data($section, $item, 'value')); }
}
}
@ -51,9 +50,7 @@ sub add {
my ($type, $section, $item, $value, $is_default) = @_;
$type = lc $type;
if ($is_default) {
return if $self->{registry}->exists($section, $item);
}
if ($is_default) { return if $self->{registry}->exists($section, $item); }
if (not $self->{registry}->exists($section, $item)) {
my $data = {
@ -84,18 +81,14 @@ sub set {
my ($self, $section, $item, $key, $value, $is_default, $dont_save) = @_;
$key = lc $key if defined $key;
if ($is_default) {
return if $self->{registry}->exists($section, $item, $key);
}
if ($is_default) { return if $self->{registry}->exists($section, $item, $key); }
my $oldvalue = $self->get_value($section, $item, 1) if defined $value;
$oldvalue = '' if not defined $oldvalue;
my $result = $self->{registry}->set($section, $item, $key, $value, 1);
if (defined $key and $key eq 'value' and defined $value and $oldvalue ne $value) {
$self->process_trigger($section, $item, $value);
}
if (defined $key and $key eq 'value' and defined $value and $oldvalue ne $value) { $self->process_trigger($section, $item, $value); }
$self->save if !$dont_save && $result =~ m/set to/ && not $is_default;
return $result;
@ -116,17 +109,12 @@ sub get_value {
# TODO: use user-metadata for this
if (defined $stuff and exists $stuff->{nick}) {
my $stuff_nick = lc $stuff->{nick};
if ($self->{registry}->exists($section, "$item.nick.$stuff_nick")) {
$key = "$item.nick.$stuff_nick";
}
if ($self->{registry}->exists($section, "$item.nick.$stuff_nick")) { $key = "$item.nick.$stuff_nick"; }
}
if ($self->{registry}->exists($section, $key)) {
if (not $as_text and $self->{registry}->get_data($section, $key, 'type') eq 'array') {
return split /\s*,\s*/, $self->{registry}->get_data($section, $key, 'value');
} else {
return $self->{registry}->get_data($section, $key, 'value');
}
if (not $as_text and $self->{registry}->get_data($section, $key, 'type') eq 'array') { return split /\s*,\s*/, $self->{registry}->get_data($section, $key, 'value'); }
else { return $self->{registry}->get_data($section, $key, 'value'); }
}
return undef;
}
@ -140,9 +128,7 @@ sub get_array_value {
# TODO: use user-metadata for this
if (defined $stuff and exists $stuff->{nick}) {
my $stuff_nick = lc $stuff->{nick};
if ($self->{registry}->exists($section, "$item.nick.$stuff_nick")) {
$key = "$item.nick.$stuff_nick";
}
if ($self->{registry}->exists($section, "$item.nick.$stuff_nick")) { $key = "$item.nick.$stuff_nick"; }
}
if ($self->{registry}->exists($section, $key)) {
@ -166,9 +152,7 @@ sub process_trigger {
my ($section, $item) = @_;
$section = lc $section;
$item = lc $item;
if (exists $self->{triggers}->{$section} and exists $self->{triggers}->{$section}->{$item}) {
return &{ $self->{triggers}->{$section}->{$item} }(@_);
}
if (exists $self->{triggers}->{$section} and exists $self->{triggers}->{$section}->{$item}) { return &{$self->{triggers}->{$section}->{$item}}(@_); }
return undef;
}

98
PBot/RegistryCommands.pm
View File

@ -39,15 +39,10 @@ sub regset {
($item, $value) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
}
if (not defined $section or not defined $item) {
return $usage;
}
if (not defined $section or not defined $item) { return $usage; }
if (defined $value) {
$self->{pbot}->{registry}->add('text', $section, $item, $value);
} else {
return $self->{pbot}->{registry}->set($section, $item, 'value');
}
if (defined $value) { $self->{pbot}->{registry}->add('text', $section, $item, $value); }
else { return $self->{pbot}->{registry}->set($section, $item, 'value'); }
$self->{pbot}->{logger}->log("$nick!$user\@$host set registry entry [$section] $item => $value\n");
return "$section.$item set to $value";
@ -61,23 +56,14 @@ sub regunset {
# support "<section>.<key>" syntax in addition to "<section> <key>"
my $section = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // return $usage;
my $item;
if ($section =~ m/^(.+?)\.(.+)$/) {
($section, $item) = ($1, $2);
} else {
($item) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1);
}
if ($section =~ m/^(.+?)\.(.+)$/) { ($section, $item) = ($1, $2); }
else { ($item) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1); }
if (not defined $section or not defined $item) {
return $usage;
}
if (not defined $section or not defined $item) { return $usage; }
if (not $self->{pbot}->{registry}->{registry}->exits($section)) {
return "No such registry section $section.";
}
if (not $self->{pbot}->{registry}->{registry}->exits($section)) { return "No such registry section $section."; }
if (not $self->{pbot}->{registry}->{registry}->exists($section, $item)) {
return "No such item $item in section $section.";
}
if (not $self->{pbot}->{registry}->{registry}->exists($section, $item)) { return "No such item $item in section $section."; }
$self->{pbot}->{logger}->log("$nick!$user\@$host removed registry entry $section.$item\n");
$self->{pbot}->{registry}->remove($section, $item);
@ -99,9 +85,7 @@ sub regsetmeta {
($item, $key, $value) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 3);
}
if (not defined $section or not defined $item) {
return $usage;
}
if (not defined $section or not defined $item) { return $usage; }
$key = undef if not length $key;
$value = undef if not length $value;
@ -123,9 +107,7 @@ sub regunsetmeta {
($item, $key) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
}
if (not defined $section or not defined $item or not defined $key) {
return $usage;
}
if (not defined $section or not defined $item or not defined $key) { return $usage; }
return $self->{pbot}->{registry}->unset($section, $item, $key);
}
@ -138,33 +120,20 @@ sub regshow {
# support "<section>.<key>" syntax in addition to "<section> <key>"
my $section = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // return $usage;
my $item;
if ($section =~ m/^(.+?)\.(.+)$/) {
($section, $item) = ($1, $2);
} else {
($item) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1);
}
if ($section =~ m/^(.+?)\.(.+)$/) { ($section, $item) = ($1, $2); }
else { ($item) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1); }
if (not defined $section or not defined $item) {
return $usage;
}
if (not defined $section or not defined $item) { return $usage; }
if (not $registry->exists($section)) {
return "No such registry section $section.";
}
if (not $registry->exists($section)) { return "No such registry section $section."; }
if (not $registry->exists($section, $item)) {
return "No such registry item $item in section $section.";
}
if (not $registry->exists($section, $item)) { return "No such registry item $item in section $section."; }
if ($registry->get_data($section, $item, 'private')) {
return "$section.$item: <private>";
}
if ($registry->get_data($section, $item, 'private')) { return "$section.$item: <private>"; }
my $result = "$section.$item: " . $registry->get_data($section, $item, 'value');
if ($registry->get_data($section, $item, 'type') eq 'array') {
$result .= ' [array]';
}
if ($registry->get_data($section, $item, 'type') eq 'array') { $result .= ' [array]'; }
return $result;
}
@ -186,7 +155,7 @@ sub regfind {
return $usage if $arguments eq "";
$section = lc $section if defined $section;;
$section = lc $section if defined $section;
my ($text, $last_item, $last_section, $i);
$last_section = "";
@ -198,6 +167,7 @@ sub regfind {
foreach my $item_key (sort $registry->get_keys($section_key)) {
next if $item_key eq '_name';
if ($registry->get_data($section_key, $item_key, 'private')) {
# do not match on value if private
next if $item_key !~ /$arguments/i;
} else {
@ -211,10 +181,10 @@ sub regfind {
$last_section = $section_key;
}
if ($showvalues) {
if ($registry->get_data($section_key, $item_key, 'private')) {
$text .= " $item_key = <private>\n";
} else {
$text .= " $item_key = " . $registry->get_data($section_key, $item_key, 'value') . ($registry->get_data($section_key, $item_key, 'type') eq 'array' ? " [array]\n" : "\n");
if ($registry->get_data($section_key, $item_key, 'private')) { $text .= " $item_key = <private>\n"; }
else {
$text .=
" $item_key = " . $registry->get_data($section_key, $item_key, 'value') . ($registry->get_data($section_key, $item_key, 'type') eq 'array' ? " [array]\n" : "\n");
}
} else {
$text .= " $item_key\n";
@ -228,10 +198,12 @@ sub regfind {
if ($i == 1) {
chop $text;
if ($registry->get_data($last_section, $last_item, 'private')) {
return "Found one registry entry: [$last_section] $last_item: <private>";
} else {
return "Found one registry entry: [$last_section] $last_item: " . $registry->get_data($last_section, $last_item, 'value') . ($registry->get_data($last_section, $last_item, 'type') eq 'array' ? ' [array]' : '');
if ($registry->get_data($last_section, $last_item, 'private')) { return "Found one registry entry: [$last_section] $last_item: <private>"; }
else {
return
"Found one registry entry: [$last_section] $last_item: "
. $registry->get_data($last_section, $last_item, 'value')
. ($registry->get_data($last_section, $last_item, 'type') eq 'array' ? ' [array]' : '');
}
} else {
return "Found $i registry entries:\n$text" unless $i == 0;
@ -260,22 +232,16 @@ sub regchange {
}
}
if (not defined $section or not defined $item or not defined $changeto) {
return "Usage: regchange <section>.<item> s/<pattern>/<replacement>/";
}
if (not defined $section or not defined $item or not defined $changeto) { return "Usage: regchange <section>.<item> s/<pattern>/<replacement>/"; }
$section = lc $section;
$item = lc $item;
my $registry = $self->{pbot}->{registry}->{registry};
if (not $registry->exists($section)) {
return "No such registry section $section.";
}
if (not $registry->exists($section)) { return "No such registry section $section."; }
if (not $registry->exists($section, $item)) {
return "No such registry item $item in section $section.";
}
if (not $registry->exists($section, $item)) { return "No such registry item $item in section $section."; }
my $ret = eval {
use re::engine::RE2 -strict => 1;

5
PBot/SQLiteLogger.pm
View File

@ -26,6 +26,7 @@ sub new {
sub log {
my $self = shift;
$self->{buf} .= shift;
# DBI feeds us pieces at a time, so accumulate a complete line
# before outputing
if ($self->{buf} =~ tr/\n//) {
@ -38,9 +39,7 @@ sub log_message {
my $self = shift;
my $now = gettimeofday;
my $elapsed = $now - $self->{timestamp};
if ($elapsed >= 0.100) {
$self->{pbot}->{logger}->log("^^^ SLOW SQL ^^^\n");
}
if ($elapsed >= 0.100) { $self->{pbot}->{logger}->log("^^^ SLOW SQL ^^^\n"); }
$elapsed = sprintf '%10.3f', $elapsed;
$self->{pbot}->{logger}->log("$elapsed : $self->{buf}");
$self->{timestamp} = $now;

1
PBot/SQLiteLoggerLayer.pm
View File

@ -22,6 +22,7 @@ sub PUSHED {
sub OPEN {
my ($self, $path, $mode, $fh) = @_;
# $path is our logger object
$$self = $path;
return 1;

9
PBot/SelectHandler.pm
View File

@ -45,18 +45,15 @@ sub do_select {
}
if ($ret == 0) {
if (length $self->{buffers}->{$fh}) {
$self->{readers}->{$fh}->($self->{buffers}->{$fh});
}
if (length $self->{buffers}->{$fh}) { $self->{readers}->{$fh}->($self->{buffers}->{$fh}); }
$self->remove_reader($fh);
next;
}
$self->{buffers}->{$fh} .= $buf;
if (not exists $self->{readers}->{$fh}) {
$self->{pbot}->{logger}->log("Error: no reader for $fh\n");
} else {
if (not exists $self->{readers}->{$fh}) { $self->{pbot}->{logger}->log("Error: no reader for $fh\n"); }
else {
if ($ret < $length) {
$self->{readers}->{$fh}->($self->{buffers}->{$fh});
$self->{buffers}->{$fh} = "";

1
PBot/StdinReader.pm
View File

@ -12,6 +12,7 @@ use POSIX qw(tcgetpgrp getpgrp); # to check whether process is in background or
sub initialize {
my ($self, %conf) = @_;
# create implicit bot-admin account for bot
my $user = $self->{pbot}->{users}->find_user('.*', '*!stdin@pbot');
if (not defined $user or not $self->{pbot}->{capabilities}->userhas($user, 'botowner')) {

12
PBot/Timer.pm
View File

@ -10,6 +10,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::Timer;
use parent 'PBot::Class';
use warnings; use strict;
@ -38,6 +39,7 @@ sub initialize {
$self->{name} = $conf{name} // "Unnamed $timeout Second Timer";
$self->{handlers} = [];
$self->{enabled} = 0;
# alarm signal handler (poor-man's timer)
$self->{timer_func} = sub { on_tick_handler($self) };
return $self;
@ -62,6 +64,7 @@ sub on_tick_handler {
if ($self->{enabled}) {
if ($#{$self->{handlers}} > -1) {
# call handlers supplied via register() if timeout for each has elapsed
foreach my $func (@{$self->{handlers}}) {
if (defined $func->{last}) {
@ -82,6 +85,7 @@ sub on_tick_handler {
}
}
} else {
# call default overridable handler if timeout has elapsed
if (defined $self->{last}) {
$self->{last} -= $max_seconds if $seconds < $self->{last}; # handle wrap-around
@ -122,13 +126,9 @@ sub register {
my $h = {subref => $ref, timeout => $timeout, id => $id};
push @{$self->{handlers}}, $h;
if ($timeout < $min_timeout) {
$min_timeout = $timeout;
}
if ($timeout < $min_timeout) { $min_timeout = $timeout; }
if ($self->{enabled}) {
alarm $min_timeout;
}
if ($self->{enabled}) { alarm $min_timeout; }
}
sub unregister {

82
PBot/Users.pm
View File

@ -104,7 +104,8 @@ sub remove_user {
sub load {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{users}->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{users}->{filename}; }
if (not defined $filename) {
Carp::carp "No users path specified -- skipping loading of users";
@ -119,9 +120,7 @@ sub load {
$i++;
my $name = $self->{users}->get_data($channel, $hostmask, 'name');
my $password = $self->{users}->get_data($channel, $hostmask, 'password');
if (not defined $name or not defined $password) {
Carp::croak "A user in $filename is missing critical data\n";
}
if (not defined $name or not defined $password) { Carp::croak "A user in $filename is missing critical data\n"; }
}
}
$self->{pbot}->{logger}->log(" $i users loaded.\n");
@ -148,20 +147,18 @@ sub find_user_account {
foreach my $chan (sort $sort $self->{users}->get_keys) {
if (($channel !~ m/^#/ and $any_channel) or $channel =~ m/^$chan$/i) {
if (not $self->{users}->exists($chan, $hostmask)) {
# find hostmask by account name or wildcard
foreach my $mask ($self->{users}->get_keys($chan)) {
if (lc $self->{users}->get_data($chan, $mask, 'name') eq $hostmask) {
return ($chan, $mask);
}
if (lc $self->{users}->get_data($chan, $mask, 'name') eq $hostmask) { return ($chan, $mask); }
if ($mask =~ /[*?]/) {
# contains * or ? so it's converted to a regex
my $mask_quoted = quotemeta $mask;
$mask_quoted =~ s/\\\*/.*?/g;
$mask_quoted =~ s/\\\?/./g;
if ($hostmask =~ m/^$mask_quoted$/i) {
return ($chan, $mask);
}
if ($hostmask =~ m/^$mask_quoted$/i) { return ($chan, $mask); }
}
}
} else {
@ -194,18 +191,16 @@ sub find_user {
if (($channel !~ m/^#/ and $any_channel) or $channel =~ m/^$channel_regex$/i) {
foreach my $hostmask_regex ($self->{users}->get_keys($channel_regex)) {
if ($hostmask_regex =~ m/[*?]/) {
# contains * or ? so it's converted to a regex
my $hostmask_quoted = quotemeta $hostmask_regex;
$hostmask_quoted =~ s/\\\*/.*?/g;
$hostmask_quoted =~ s/\\\?/./g;
if ($hostmask =~ m/^$hostmask_quoted$/i) {
return $self->{users}->get_data($channel_regex, $hostmask_regex);
}
if ($hostmask =~ m/^$hostmask_quoted$/i) { return $self->{users}->get_data($channel_regex, $hostmask_regex); }
} else {
# direct comparison
if ($hostmask eq lc $hostmask_regex) {
return $self->{users}->get_data($channel_regex, $hostmask_regex);
}
if ($hostmask eq lc $hostmask_regex) { return $self->{users}->get_data($channel_regex, $hostmask_regex); }
}
}
}
@ -213,9 +208,7 @@ sub find_user {
return undef;
};
if ($@) {
$self->{pbot}->{logger}->log("Error in find_user parameters: $@\n");
}
if ($@) { $self->{pbot}->{logger}->log("Error in find_user parameters: $@\n"); }
return $user;
}
@ -297,9 +290,7 @@ sub logincmd {
my $u = $self->{users}->get_data($user_channel, $user_hostmask);
my $channel_text = $user_channel eq '.*' ? '' : " for $user_channel";
if ($u->{loggedin}) {
return "/msg $nick You are already logged into $u->{name} ($user_hostmask)$channel_text.";
}
if ($u->{loggedin}) { return "/msg $nick You are already logged into $u->{name} ($user_hostmask)$channel_text."; }
my $result = $self->login($user_channel, $user_hostmask, $arguments);
return "/msg $nick $result";
@ -344,7 +335,9 @@ sub users {
$sep = "";
}
foreach my $hostmask (sort { return 0 if $a eq '_name' or $b eq '_name'; $self->{users}->get_data($chan, $a, 'name') cmp $self->{users}->get_data($chan, $b, 'name') } $self->{users}->get_keys($chan)) {
foreach my $hostmask (sort { return 0 if $a eq '_name' or $b eq '_name'; $self->{users}->get_data($chan, $a, 'name') cmp $self->{users}->get_data($chan, $b, 'name') }
$self->{users}->get_keys($chan))
{
$text .= $sep;
my $has_cap = 0;
foreach my $key ($self->{users}->get_keys($chan, $hostmask)) {
@ -367,9 +360,7 @@ sub useradd {
my ($name, $channel, $hostmask, $capabilities, $password) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 5);
$capabilities //= 'none';
if (not defined $name or not defined $channel or not defined $hostmask) {
return "Usage: useradd <account name> <channel> <hostmask> [capabilities [password]]";
}
if (not defined $name or not defined $channel or not defined $hostmask) { return "Usage: useradd <account name> <channel> <hostmask> [capabilities [password]]"; }
$channel = '.*' if $channel !~ /^#/;
@ -387,9 +378,7 @@ sub useradd {
foreach my $cap (split /\s*,\s*/, lc $capabilities) {
next if $cap eq 'none';
return "There is no such capability $cap." if not $self->{pbot}->{capabilities}->exists($cap);
if (not $self->{pbot}->{capabilities}->userhas($u, $cap)) {
return "To set the $cap capability your user account must also have it.";
}
if (not $self->{pbot}->{capabilities}->userhas($u, $cap)) { return "To set the $cap capability your user account must also have it."; }
if ($self->{pbot}->{capabilities}->has($cap, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To set the $cap capability your user account must have the can-modify-admins capability.";
}
@ -402,9 +391,7 @@ sub userdel {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
my ($channel, $hostmask) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
if (not defined $channel or not defined $hostmask) {
return "Usage: userdel <channel> <hostmask or account name>";
}
if (not defined $channel or not defined $hostmask) { return "Usage: userdel <channel> <hostmask or account name>"; }
my $u = $self->find_user($channel, "$nick!$user\@$host");
my $t = $self->find_user($channel, $hostmask);
@ -425,15 +412,11 @@ sub userdel {
sub userset {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
if (length $arguments and $stuff->{arglist}[0] !~ m/^(#|\.\*$|global$)/) {
$self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $from)
}
if (length $arguments and $stuff->{arglist}[0] !~ m/^(#|\.\*$|global$)/) { $self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $from) }
my ($channel, $hostmask, $key, $value) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 4);
if (not defined $hostmask) {
return "Usage: userset [channel] <hostmask or account name> [key [value]]";
}
if (not defined $hostmask) { return "Usage: userset [channel] <hostmask or account name> [key [value]]"; }
my $u = $self->find_user($channel, "$nick!$user\@$host");
my $target = $self->find_user($channel, $hostmask);
@ -444,11 +427,8 @@ sub userset {
}
if (not $target) {
if ($channel !~ /^#/) {
return "There is no user account $hostmask.";
} else {
return "There is no user account $hostmask for $channel.";
}
if ($channel !~ /^#/) { return "There is no user account $hostmask."; }
else { return "There is no user account $hostmask for $channel."; }
}
if (defined $value and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
@ -475,15 +455,11 @@ sub userset {
sub userunset {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
if (length $arguments and $stuff->{arglist}[0] !~ m/^(#|\.\*$|global$)/) {
$self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $from)
}
if (length $arguments and $stuff->{arglist}[0] !~ m/^(#|\.\*$|global$)/) { $self->{pbot}->{interpreter}->unshift_arg($stuff->{arglist}, $from) }
my ($channel, $hostmask, $key) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 3);
if (not defined $hostmask) {
return "Usage: userunset [channel] <hostmask or account name> <key>";
}
if (not defined $hostmask) { return "Usage: userunset [channel] <hostmask or account name> <key>"; }
my $u = $self->find_user($channel, "$nick!$user\@$host");
my $target = $self->find_user($channel, $hostmask);
@ -494,11 +470,8 @@ sub userunset {
}
if (not $target) {
if ($channel !~ /^#/) {
return "There is no user account $hostmask.";
} else {
return "There is no user account $hostmask for $channel.";
}
if ($channel !~ /^#/) { return "There is no user account $hostmask."; }
else { return "There is no user account $hostmask for $channel."; }
}
if (defined $key and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
@ -541,6 +514,7 @@ sub mycmd {
my ($existing_channel, $existing_hostmask) = $self->find_user_account($channel, $name);
if ($existing_hostmask ne lc $name) {
# user exists by name
return "There is already an user account named $name but its hostmask ($existing_hostmask) does not match your hostmask ($hostmask). Ask an admin for help.";
}

2
PBot/Utils/Indefinite.pm
View File

@ -1,4 +1,5 @@
package PBot::Utils::Indefinite;
use 5.010; use warnings;
use feature 'unicode_strings';
@ -84,7 +85,6 @@ sub select_indefinite_article {
return "a";
}
1; # Magic true value required at end of module
__END__

6
PBot/Utils/LWPUserAgentCached.pm
View File

@ -23,9 +23,7 @@ sub new {
unless (scalar @_ % 2) {
%lwp_opt = @_;
$cache_opt = {};
for my $key (qw(namespace cache_root default_expires_in)) {
$cache_opt->{$key} = delete $lwp_opt{$key} if exists $lwp_opt{$key};
}
for my $key (qw(namespace cache_root default_expires_in)) { $cache_opt->{$key} = delete $lwp_opt{$key} if exists $lwp_opt{$key}; }
} else {
$cache_opt = shift || {};
%lwp_opt = @_;
@ -33,7 +31,7 @@ sub new {
my $self = $class->SUPER::new(%lwp_opt);
my %cache_args = (%default_cache_args, %$cache_opt);
$self->{cache} = Cache::FileCache->new(\%cache_args);
return $self
return $self;
}
sub request {

10
PBot/Utils/ParseDate.pm
View File

@ -60,7 +60,8 @@ sub parsedate {
$input =~ s/\b(\d+)\s+(am?|pm?)\b/$1$2/; # remove leading spaces from am/pm
$input =~ s/ (\d+)(am?|pm?)\b/ $1:00:00$2/; # convert 3pm to 3:00:00pm
$input =~ s/ (\d+:\d+)(am?|pm?)\b/ $1:00$2/; # convert 4:20pm to 4:20:00pm
$input =~ s/next (jan(?:uary)?|feb(?:ruary)?|mar(?:ch)?|apr(?:il)?|may|june?|july?|aug(?:ust)?|sept(?:ember)?|oct(?:ober)?|nov(?:ember)|dec(?:ember)?) (\d+)(?:st|nd|rd|th)?(.*)/"next $1 and " . ($2 - 1) . " days" . (length $3 ? " and $3" : "")/ie;
$input =~
s/next (jan(?:uary)?|feb(?:ruary)?|mar(?:ch)?|apr(?:il)?|may|june?|july?|aug(?:ust)?|sept(?:ember)?|oct(?:ober)?|nov(?:ember)|dec(?:ember)?) (\d+)(?:st|nd|rd|th)?(.*)/"next $1 and " . ($2 - 1) . " days" . (length $3 ? " and $3" : "")/ie;
# split input on "and" or comma, then we'll add up the results
# this allows us to parse things like "1 hour and 30 minutes"
@ -125,11 +126,8 @@ sub parsedate {
# If the time is in the past, prepend "tomorrow" or "next" and reparse
if ($duration->is_negative) {
if ($input =~ m/^\d/) {
$override = "tomorrow ";
} else {
$override = "next ";
}
if ($input =~ m/^\d/) { $override = "tomorrow "; }
else { $override = "next "; }
$to = undef;
goto TRY_AGAIN;
}

11
PBot/Utils/SafeFilename.pm
View File

@ -1,4 +1,5 @@
package PBot::Utils::SafeFilename;
use 5.010; use warnings;
use feature 'unicode_strings';
@ -11,13 +12,9 @@ sub safe_filename {
my $safe = '';
while ($name =~ m/(.)/gms) {
if ($1 eq '&') {
$safe .= '&amp;';
} elsif ($1 eq '/') {
$safe .= '&fslash;';
} else {
$safe .= $1;
}
if ($1 eq '&') { $safe .= '&amp;'; }
elsif ($1 eq '/') { $safe .= '&fslash;'; }
else { $safe .= $1; }
}
return lc $safe;

6
PBot/Utils/ValidateString.pm
View File

@ -19,14 +19,12 @@ sub validate_string {
eval {
my $h = decode_json($string);
foreach my $k (keys %$h) {
$h->{$k} = substr $h->{$k}, 0, $max_length unless $max_length <= 0;
}
foreach my $k (keys %$h) { $h->{$k} = substr $h->{$k}, 0, $max_length unless $max_length <= 0; }
$string = encode_json($h);
};
if ($@) {
# not a json string
$string = substr $string, 0, $max_length unless $max_length <= 0;
}

12
PBot/VERSION.pm
View File

@ -29,9 +29,7 @@ sub initialize {
$self->{last_check} = {timestamp => 0, version => BUILD_REVISION, date => BUILD_DATE};
}
sub version {
return BUILD_NAME . " version " . BUILD_REVISION . " " . BUILD_DATE;
}
sub version { return BUILD_NAME . " version " . BUILD_REVISION . " " . BUILD_DATE; }
sub version_cmd {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
@ -51,9 +49,7 @@ sub version_cmd {
my $text = $response->decoded_content;
my ($version, $date) = $text =~ m/^\s+BUILD_REVISION => (\d+).*^\s+BUILD_DATE\s+=> "([^"]+)"/ms;
if (not defined $version or not defined $date) {
return "Unable to get version information: data did not match expected format";
}
if (not defined $version or not defined $date) { return "Unable to get version information: data did not match expected format"; }
$self->{last_check} = {timestamp => time, version => $version, date => $date};
}
@ -65,9 +61,7 @@ sub version_cmd {
$result .= "$target_nick: " if $target_nick;
$result .= $self->version;
if ($self->{last_check}->{version} > BUILD_REVISION) {
$result .= "; new version available: $self->{last_check}->{version} $self->{last_check}->{date}!";
}
if ($self->{last_check}->{version} > BUILD_REVISION) { $result .= "; new version available: $self->{last_check}->{version} $self->{last_check}->{date}!"; }
return $result;
}

5
PBot/WebPaste.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::WebPaste;
use parent 'PBot::Class';
use warnings; use strict;
@ -31,9 +32,7 @@ sub initialize {
sub get_paste_site {
my ($self) = @_;
my $subref = $self->{paste_sites}->[$self->{current_site}];
if (++$self->{current_site} >= @{$self->{paste_sites}}) {
$self->{current_site} = 0;
}
if (++$self->{current_site} >= @{$self->{paste_sites}}) { $self->{current_site} = 0; }
return $subref;
}

77
Plugins/ActionTrigger.pm
View File

@ -92,7 +92,8 @@ SQL
sub dbi_begin {
my ($self) = @_;
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1 }) or die $DBI::errstr;
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
or die $DBI::errstr;
};
if ($@) {
@ -151,9 +152,7 @@ sub list_triggers {
return $sth->fetchall_arrayref({});
};
if ($@) {
$self->{pbot}->{logger}->log("List triggers failed: $@");
}
if ($@) { $self->{pbot}->{logger}->log("List triggers failed: $@"); }
$triggers = [] if not defined $triggers;
return @$triggers;
@ -174,9 +173,7 @@ sub update_trigger {
$sql .= "WHERE trigger = ? AND channel = ?";
my $sth = $self->{dbh}->prepare($sql);
my $param = 1;
foreach my $key (keys %$data) {
$sth->bind_param($param++, $data->{$key});
}
foreach my $key (keys %$data) { $sth->bind_param($param++, $data->{$key}); }
$sth->bind_param($param++, $trigger);
$sth->bind_param($param, $channel);
@ -289,9 +286,7 @@ sub check_trigger {
}
};
if ($@) {
$self->{pbot}->{logger}->log("Skipping bad trigger $trigger->{trigger}: $@");
}
if ($@) { $self->{pbot}->{logger}->log("Skipping bad trigger $trigger->{trigger}: $@"); }
}
return 0;
}
@ -306,20 +301,16 @@ sub actiontrigger {
when ('list') {
my $channel = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist});
if (not defined $channel) {
if ($from !~ /^#/) {
$channel = 'global';
} else {
$channel = $from;
}
if ($from !~ /^#/) { $channel = 'global'; }
else { $channel = $from; }
} elsif ($channel !~ m/^#/ and $channel ne 'global') {
return "Invalid channel $channel. Usage: actiontrigger list [#channel or global]";
}
my @triggers = $self->list_triggers($channel);
if (not @triggers) {
$result = "No action triggers set for $channel.";
} else {
if (not @triggers) { $result = "No action triggers set for $channel."; }
else {
$result = "Triggers for $channel:\n";
my $comma = '';
foreach my $trigger (@triggers) {
@ -336,13 +327,13 @@ sub actiontrigger {
# TODO: use GetOpt flags instead of positional arguments
when ('add') {
my $channel;
if ($from =~ m/^#/) {
$channel = $from;
} else {
if ($from =~ m/^#/) { $channel = $from; }
else {
$channel = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist});
if (not defined $channel) {
return "To use this command from private message the <channel> argument is required. Usage: actiontrigger add <#channel or global> <level> <repeat delay (in seconds)> <regex trigger> <command>";
return
"To use this command from private message the <channel> argument is required. Usage: actiontrigger add <#channel or global> <level> <repeat delay (in seconds)> <regex trigger> <command>";
} elsif ($channel !~ m/^#/ and $channel ne 'global') {
return "Invalid channel $channel. Usage: actiontrigger add <#channel or global> <level> <repeat delay (in seconds)> <regex trigger> <command>";
}
@ -352,7 +343,8 @@ sub actiontrigger {
if (not defined $trigger or not defined $action) {
if ($from !~ m/^#/) {
$result = "To use this command from private message the <channel> argument is required. Usage: actiontrigger add <#channel or global> <level> <repeat delay (in seconds)> <regex trigger> <command>";
$result =
"To use this command from private message the <channel> argument is required. Usage: actiontrigger add <#channel or global> <level> <repeat delay (in seconds)> <regex trigger> <command>";
} else {
$result = "Usage: actiontrigger add <level> <repeat delay (in seconds)> <regex trigger> <command>";
}
@ -361,37 +353,25 @@ sub actiontrigger {
my $exists = $self->get_trigger($channel, $trigger);
if (defined $exists) {
return "Trigger already exists.";
}
if (defined $exists) { return "Trigger already exists."; }
if ($level !~ m/^\d+$/) {
return "$nick: Missing level argument?\n";
}
if ($level !~ m/^\d+$/) { return "$nick: Missing level argument?\n"; }
if ($repeatdelay !~ m/^\d+$/) {
return "$nick: Missing repeat delay argument?\n";
}
if ($repeatdelay !~ m/^\d+$/) { return "$nick: Missing repeat delay argument?\n"; }
if ($level > 0) {
my $admin = $self->{pbot}->{users}->find_admin($channel, "$nick!$user\@$host");
if (not defined $admin or $level > $admin->{level}) {
return "You may not set a level higher than your own.";
}
if (not defined $admin or $level > $admin->{level}) { return "You may not set a level higher than your own."; }
}
if ($self->add_trigger($channel, $trigger, $action, "$nick!$user\@$host", $level, $repeatdelay)) {
$result = "Trigger added.";
} else {
$result = "Failed to add trigger.";
}
if ($self->add_trigger($channel, $trigger, $action, "$nick!$user\@$host", $level, $repeatdelay)) { $result = "Trigger added."; }
else { $result = "Failed to add trigger."; }
}
when ('delete') {
my $channel;
if ($from =~ m/^#/) {
$channel = $from;
} else {
if ($from =~ m/^#/) { $channel = $from; }
else {
$channel = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist});
if ($channel !~ m/^#/ and $channel ne 'global') {
return "To use this command from private message the <channel> argument is required. Usage: actiontrigger delete <#channel or global> <regex trigger>";
@ -411,9 +391,8 @@ sub actiontrigger {
my $exists = $self->get_trigger($channel, $trigger);
if (not defined $exists) {
$result = "No such trigger.";
} else {
if (not defined $exists) { $result = "No such trigger."; }
else {
$self->delete_trigger($channel, $trigger);
$result = "Trigger deleted.";
}
@ -421,9 +400,11 @@ sub actiontrigger {
default {
if ($from !~ m/^#/) {
$result = "Usage from private message: actiontrigger list [#channel or global] | actiontrigger add <#channel or global> <level> <repeat delay (in seconds)> <regex trigger> <command> | actiontrigger delete <#channel or global> <regex trigger>";
$result =
"Usage from private message: actiontrigger list [#channel or global] | actiontrigger add <#channel or global> <level> <repeat delay (in seconds)> <regex trigger> <command> | actiontrigger delete <#channel or global> <regex trigger>";
} else {
$result = "Usage: actiontrigger list [#channel or global] | actiontrigger add <level> <repeat delay (in seconds)> <regex trigger> <command> | actiontrigger delete <regex>";
$result =
"Usage: actiontrigger list [#channel or global] | actiontrigger add <level> <repeat delay (in seconds)> <regex trigger> <command> | actiontrigger delete <regex>";
}
}
}

3
Plugins/AntiAway.pm
View File

@ -15,7 +15,8 @@ use feature 'unicode_strings';
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{registry}->add_default('text', 'antiaway', 'bad_nicks', $conf{bad_nicks} // '([[:punct:]](afk|brb|bbl|away|sleep|z+|work|gone|study|out|home|busy|off)[[:punct:]]*$|.+\[.*\]$)');
$self->{pbot}->{registry}
->add_default('text', 'antiaway', 'bad_nicks', $conf{bad_nicks} // '([[:punct:]](afk|brb|bbl|away|sleep|z+|work|gone|study|out|home|busy|off)[[:punct:]]*$|.+\[.*\]$)');
$self->{pbot}->{registry}->add_default('text', 'antiaway', 'bad_actions', $conf{bad_actions} // '^/me (is (away|gone)|.*auto.?away)');
$self->{pbot}->{registry}->add_default('text', 'antiaway', 'kick_msg', 'http://sackheads.org/~bnaylor/spew/away_msgs.html');

12
Plugins/AntiKickAutoRejoin.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::AntiKickAutoRejoin;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -34,16 +35,14 @@ sub unload {
sub on_kick {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $target, $channel, $reason) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to, $event->{event}->{args}[0], $event->{event}->{args}[1]);
my ($nick, $user, $host, $target, $channel, $reason) =
($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to, $event->{event}->{args}[0], $event->{event}->{args}[1]);
$channel = lc $channel;
return 0 if not $self->{pbot}->{chanops}->can_gain_ops($channel);
return 0 if $reason eq '*BANG!*'; # roulette
if (not exists $self->{kicks}->{$channel}
or not exists $self->{kicks}->{$channel}->{$target}) {
$self->{kicks}->{$channel}->{$target}->{rejoins} = 0;
}
if (not exists $self->{kicks}->{$channel} or not exists $self->{kicks}->{$channel}->{$target}) { $self->{kicks}->{$channel}->{$target}->{rejoins} = 0; }
$self->{kicks}->{$channel}->{$target}->{last_kick} = gettimeofday;
return 0;
@ -58,8 +57,7 @@ sub on_join {
my $u = $self->{pbot}->{users}->loggedin($channel, "$nick!$user\@$host");
return 0 if $self->{pbot}->{capabilities}->userhas($u, 'is-whitelisted');
if (exists $self->{kicks}->{$channel}
and exists $self->{kicks}->{$channel}->{$nick}) {
if (exists $self->{kicks}->{$channel} and exists $self->{kicks}->{$channel}->{$nick}) {
my $now = gettimeofday;
if ($now - $self->{kicks}->{$channel}->{$nick}->{last_kick} <= $self->{pbot}->{registry}->get_value('antikickautorejoin', 'threshold')) {

8
Plugins/AntiNickSpam.pm
View File

@ -9,6 +9,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::AntiNickSpam;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -78,11 +79,8 @@ sub clear_old_nicks {
return if not exists $self->{nicks}->{$channel};
while (1) {
if (@{$self->{nicks}->{$channel}} and $self->{nicks}->{$channel}->[0]->[0] <= $now - 15) {
shift @{$self->{nicks}->{$channel}};
} else {
last;
}
if (@{$self->{nicks}->{$channel}} and $self->{nicks}->{$channel}->[0]->[0] <= $now - 15) { shift @{$self->{nicks}->{$channel}}; }
else { last; }
}
delete $self->{nicks}->{$channel} if not @{$self->{nicks}->{$channel}};
}

32
Plugins/AntiRepeat.pm
View File

@ -69,14 +69,11 @@ sub on_public {
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $bot_trigger = $self->{pbot}->{registry}->get_value($channel, 'trigger')
// $self->{pbot}->{registry}->get_value('general', 'trigger');
my $bot_trigger = $self->{pbot}->{registry}->get_value($channel, 'trigger') // $self->{pbot}->{registry}->get_value('general', 'trigger');
my $allow_bot = $self->{pbot}->{registry}->get_value($channel, 'antirepeat_allow_bot')
// $self->{pbot}->{registry}->get_value('antiflood', 'antirepeat_allow_bot');
my $allow_bot = $self->{pbot}->{registry}->get_value($channel, 'antirepeat_allow_bot') // $self->{pbot}->{registry}->get_value('antiflood', 'antirepeat_allow_bot');
my $match = $self->{pbot}->{registry}->get_value($channel, 'antirepeat_match')
// $self->{pbot}->{registry}->get_value('antiflood', 'antirepeat_match');
my $match = $self->{pbot}->{registry}->get_value($channel, 'antirepeat_match') // $self->{pbot}->{registry}->get_value('antiflood', 'antirepeat_match');
my %matches;
my $now = gettimeofday;
@ -108,15 +105,12 @@ sub on_public {
my $length1 = $length / length $string1->{msg};
my $length2 = $length / length $string2->{msg};
if ($length1 >= $match && $length2 >= $match) {
$matches{$string}++;
}
if ($length1 >= $match && $length2 >= $match) { $matches{$string}++; }
}
}
}
my $threshold = $self->{pbot}->{registry}->get_value($channel, 'antirepeat_threshold')
// $self->{pbot}->{registry}->get_value('antiflood', 'antirepeat_threshold');
my $threshold = $self->{pbot}->{registry}->get_value($channel, 'antirepeat_threshold') // $self->{pbot}->{registry}->get_value('antiflood', 'antirepeat_threshold');
foreach my $match (keys %matches) {
if (sqrt $matches{$match} > $threshold) {
@ -131,15 +125,9 @@ sub on_public {
$self->{pbot}->{chanops}->add_op_command($channel, "kick $channel $nick Stop repeating yourself");
$self->{pbot}->{chanops}->gain_ops($channel);
}
when (2) {
$self->{pbot}->{chanops}->ban_user_timed($botnick, 'repeating messages', "*!*\@$host", $channel, 60);
}
when (3) {
$self->{pbot}->{chanops}->ban_user_timed($botnick, 'repeating messages', "*!*\@$host", $channel, 60 * 15);
}
default {
$self->{pbot}->{chanops}->ban_user_timed($botnick, 'repeating messages', "*!*\@$host", $channel, 60 * 60);
}
when (2) { $self->{pbot}->{chanops}->ban_user_timed($botnick, 'repeating messages', "*!*\@$host", $channel, 60); }
when (3) { $self->{pbot}->{chanops}->ban_user_timed($botnick, 'repeating messages', "*!*\@$host", $channel, 60 * 15); }
default { $self->{pbot}->{chanops}->ban_user_timed($botnick, 'repeating messages', "*!*\@$host", $channel, 60 * 60); }
}
return 0;
}
@ -158,9 +146,7 @@ sub adjust_offenses {
if ($self->{offenses}->{$account}->{$channel}->{offenses} <= 0) {
delete $self->{offenses}->{$account}->{$channel};
if (keys %{ $self->{offenses}->{$account} } == 0) {
delete $self->{offenses}->{$account};
}
if (keys %{$self->{offenses}->{$account}} == 0) { delete $self->{offenses}->{$account}; }
} else {
$self->{offenses}->{$account}->{$channel}->{last_adjustment} = $now;
}

14
Plugins/AntiTwitter.pm
View File

@ -9,6 +9,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::AntiTwitter;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -18,6 +19,7 @@ use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/duration/;
use feature 'switch';
no if $] >= 5.018, warnings => "experimental::smartmatch";
sub initialize {
@ -49,11 +51,10 @@ sub on_public {
$self->{pbot}->{logger}->log("$nick!$user\@$host is a twit. ($self->{offenses}->{$channel}->{$nick}->{offenses} offenses) $channel: $msg\n");
given ($self->{offenses}->{$channel}->{$nick}->{offenses}) {
when (1) {
$event->{conn}->privmsg($nick, "Please do not use \@nick to address people. Drop the @ symbol; it's not necessary and it's ugly.");
}
when (1) { $event->{conn}->privmsg($nick, "Please do not use \@nick to address people. Drop the @ symbol; it's not necessary and it's ugly."); }
when (2) {
$event->{conn}->privmsg($nick, "Please do not use \@nick to address people. Drop the @ symbol; it's not necessary and it's ugly. Doing this again will result in a temporary ban.");
$event->{conn}
->privmsg($nick, "Please do not use \@nick to address people. Drop the @ symbol; it's not necessary and it's ugly. Doing this again will result in a temporary ban.");
}
default {
my $offenses = $self->{offenses}->{$channel}->{$nick}->{offenses} - 2;
@ -61,7 +62,10 @@ sub on_public {
$self->{pbot}->{chanops}->ban_user_timed($self->{pbot}->{registry}->get_value('irc', 'botnick'), 'using @nick too much', "*!*\@$host", $channel, $length);
$self->{pbot}->{chanops}->gain_ops($channel);
$length = duration $length;
$event->{conn}->privmsg($nick, "Please do not use \@nick to address people. Drop the @ symbol; it's not necessary and it's ugly. You were warned. You will be allowed to speak again in $length.");
$event->{conn}->privmsg(
$nick,
"Please do not use \@nick to address people. Drop the @ symbol; it's not necessary and it's ugly. You were warned. You will be allowed to speak again in $length."
);
}
}
last;

12
Plugins/AutoRejoin.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::AutoRejoin;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -46,14 +47,13 @@ sub rejoin_channel {
sub on_kick {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $target, $channel, $reason) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to, $event->{event}->{args}[0], $event->{event}->{args}[1]);
my ($nick, $user, $host, $target, $channel, $reason) =
($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to, $event->{event}->{args}[0], $event->{event}->{args}[1]);
return 0 if not $self->{pbot}->{channels}->is_active($channel);
return 0 if $self->{pbot}->{channels}->{channels}->{hash}->{lc $channel}->{noautorejoin};
if ($target eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) {
$self->rejoin_channel($channel);
}
if ($target eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) { $self->rejoin_channel($channel); }
return 0;
}
@ -64,9 +64,7 @@ sub on_part {
return 0 if not $self->{pbot}->{channels}->is_active($channel);
return 0 if $self->{pbot}->{channels}->{channels}->{hash}->{lc $channel}->{noautorejoin};
if ($nick eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) {
$self->rejoin_channel($channel);
}
if ($nick eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) { $self->rejoin_channel($channel); }
return 0;
}

369
Plugins/Battleship.pm
View File

@ -3,6 +3,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::Battleship;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -10,6 +11,7 @@ use feature 'unicode_strings';
use utf8;
use feature 'switch';
no if $] >= 5.018, warnings => "experimental::smartmatch";
use Time::Duration qw/concise duration/;
@ -107,28 +109,19 @@ sub battleship_cmd {
given ($command) {
when ('help') {
given ($arguments) {
when ('help') {
return "Seriously?";
}
when ('help') { return "Seriously?"; }
default {
if (length $arguments) {
return "Battleship help is coming soon.";
} else {
return "Usage: battleship help <command>";
}
if (length $arguments) { return "Battleship help is coming soon."; }
else { return "Usage: battleship help <command>"; }
}
}
}
when ('leaderboard') {
return "Coming soon.";
}
when ('leaderboard') { return "Coming soon."; }
when ('challenge') {
if ($self->{current_state} ne 'nogame') {
return "There is already a game of Battleship underway.";
}
if ($self->{current_state} ne 'nogame') { return "There is already a game of Battleship underway."; }
if (not length $arguments) {
$self->{current_state} = 'accept';
@ -145,9 +138,7 @@ sub battleship_cmd {
my $challengee = $self->{pbot}->{nicklist}->is_present($self->{channel}, $arguments);
if (not $challengee) {
return "That nick is not present in this channel. Invite them to $self->{channel} and try again!";
}
if (not $challengee) { return "That nick is not present in this channel. Invite them to $self->{channel} and try again!"; }
$self->{current_state} = 'accept';
$self->{state_data} = {players => [], counter => 0};
@ -164,9 +155,7 @@ sub battleship_cmd {
}
when ('accept') {
if ($self->{current_state} ne 'accept') {
return "/msg $nick This is not the time to use `accept`.";
}
if ($self->{current_state} ne 'accept') { return "/msg $nick This is not the time to use `accept`."; }
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
my $player = $self->{state_data}->{players}->[1];
@ -197,9 +186,7 @@ sub battleship_cmd {
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
if (@{$self->{state_data}->{players}} == 2 and ($self->{state_data}->{players}->[1]->{id} == -1 || not $self->{state_data}->{players}->[1]->{accepted})) {
return "/msg $self->{channel} $nick declined the challenge.";
@ -212,9 +199,7 @@ sub battleship_cmd {
}
when ('abort') {
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) {
return "$nick: Sorry, only admins may abort the game.";
}
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) { return "$nick: Sorry, only admins may abort the game."; }
$self->{current_state} = 'gameover';
return "/msg $self->{channel} $nick: The game has been aborted.";
@ -230,23 +215,15 @@ sub battleship_cmd {
}
when ('players') {
if ($self->{current_state} eq 'accept') {
return "$self->{state_data}->{players}->[0]->{name} has challenged $self->{state_data}->{players}->[1]->{name}!";
} elsif (@{$self->{state_data}->{players}} == 2) {
return "$self->{state_data}->{players}->[0]->{name} is in battle with $self->{state_data}->{players}->[1]->{name}!";
} else {
return "There are no players playing right now. Start a game with `battleship challenge <nick>`!";
}
if ($self->{current_state} eq 'accept') { return "$self->{state_data}->{players}->[0]->{name} has challenged $self->{state_data}->{players}->[1]->{name}!"; }
elsif (@{$self->{state_data}->{players}} == 2) { return "$self->{state_data}->{players}->[0]->{name} is in battle with $self->{state_data}->{players}->[1]->{name}!"; }
else { return "There are no players playing right now. Start a game with `battleship challenge <nick>`!"; }
}
when ('kick') {
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) {
return "$nick: Sorry, only admins may kick people from the game.";
}
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) { return "$nick: Sorry, only admins may kick people from the game."; }
if (not length $arguments) {
return "Usage: battleship kick <nick>";
}
if (not length $arguments) { return "Usage: battleship kick <nick>"; }
my $removed = 0;
@ -258,9 +235,7 @@ sub battleship_cmd {
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
return "/msg $self->{channel} $nick: $arguments has been kicked from the game.";
} else {
return "$nick: $arguments isn't even in the game.";
@ -268,36 +243,23 @@ sub battleship_cmd {
}
when ('bomb') {
if ($self->{debug}) {
$self->{pbot}->{logger}->log("Battleship: bomb state: $self->{current_state}\n" . Dumper $self->{state_data});
}
if ($self->{debug}) { $self->{pbot}->{logger}->log("Battleship: bomb state: $self->{current_state}\n" . Dumper $self->{state_data}); }
if ($self->{current_state} ne 'playermove' and $self->{current_state} ne 'checkplayer') {
return "$nick: It's not time to do that now.";
}
if ($self->{current_state} ne 'playermove' and $self->{current_state} ne 'checkplayer') { return "$nick: It's not time to do that now."; }
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
my $player;
if ($self->{state_data}->{players}->[0]->{id} == $id) {
$player = 0;
} elsif ($self->{state_data}->{players}->[1]->{id} == $id) {
$player = 1;
} else {
return "You are not playing in this game.";
}
if ($self->{state_data}->{players}->[0]->{id} == $id) { $player = 0; }
elsif ($self->{state_data}->{players}->[1]->{id} == $id) { $player = 1; }
else { return "You are not playing in this game."; }
if (not length $arguments) {
if (delete $self->{state_data}->{players}->[$player]->{location}) {
return "$nick: Attack location cleared.";
} else {
return "$nick: Usage: bomb <location>";
}
if (delete $self->{state_data}->{players}->[$player]->{location}) { return "$nick: Attack location cleared."; }
else { return "$nick: Usage: bomb <location>"; }
}
if ($arguments !~ m/^[a-zA-Z][0-9]+$/) {
return "$nick: Usage: battleship bomb <location>; <location> must be in the form of A15, B3, C9, etc.";
}
if ($arguments !~ m/^[a-zA-Z][0-9]+$/) { return "$nick: Usage: battleship bomb <location>; <location> must be in the form of A15, B3, C9, etc."; }
$arguments = uc $arguments;
@ -305,27 +267,19 @@ sub battleship_cmd {
($x) = $arguments =~ m/^(.)/;
($y) = $arguments =~ m/^.(.*)/;
$x = ord($x) - 65;;
if ($x < 0 || $x > $self->{N_Y} || $y < 0 || $y > $self->{N_X}) {
return "$nick: Target out of range, try again.";
}
$x = ord($x) - 65;
if ($x < 0 || $x > $self->{N_Y} || $y < 0 || $y > $self->{N_X}) { return "$nick: Target out of range, try again."; }
if ($self->{state_data}->{current_player} != $player) {
my $msg;
if (not exists $self->{state_data}->{players}->[$player]->{location}) {
$msg = "$nick: You will attack $arguments when it is your turn.";
} else {
$msg = "$nick: You will now attack $arguments instead of $self->{state_data}->{players}->[$player]->{location} when it is your turn.";
}
if (not exists $self->{state_data}->{players}->[$player]->{location}) { $msg = "$nick: You will attack $arguments when it is your turn."; }
else { $msg = "$nick: You will now attack $arguments instead of $self->{state_data}->{players}->[$player]->{location} when it is your turn."; }
$self->{state_data}->{players}->[$player]->{location} = $arguments;
return $msg;
}
if ($self->{player}->[$player]->{done}) {
return "$nick: You have already attacked this turn.";
}
if ($self->{player}->[$player]->{done}) { return "$nick: You have already attacked this turn."; }
if ($self->bomb($player, uc $arguments)) {
if ($self->{player}->[$player]->{won}) {
@ -344,8 +298,7 @@ sub battleship_cmd {
}
when ($_ eq 'specboard' or $_ eq 'board') {
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept'
or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept' or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
return "$nick: There is no board to show right now.";
}
@ -366,12 +319,9 @@ sub battleship_cmd {
}
when ('fullboard') {
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) {
return "$nick: Sorry, only admins may see the full board.";
}
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) { return "$nick: Sorry, only admins may see the full board."; }
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept'
or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept' or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
return "$nick: There is no board to show right now.";
}
@ -387,9 +337,7 @@ sub battleship_cmd {
$self->show_battlefield(4, $nick);
}
default {
return $usage;
}
default { return $usage; }
}
return $result;
@ -415,9 +363,7 @@ sub player_left {
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
return "/msg $self->{channel} $nick has left the game!";
}
}
@ -441,21 +387,20 @@ sub run_one_state {
my $removed = 0;
for (my $i = 0; $i < @{$self->{state_data}->{players}}; $i++) {
if ($self->{state_data}->{players}->[$i]->{missedinputs} >= 3) {
$self->send_message($self->{channel}, "$color{red}$self->{state_data}->{players}->[$i]->{name} has missed too many prompts and has been ejected from the game!$color{reset}");
$self->send_message(
$self->{channel},
"$color{red}$self->{state_data}->{players}->[$i]->{name} has missed too many prompts and has been ejected from the game!$color{reset}"
);
$self->{state_data}->{players}->[$i]->{removed} = 1;
$removed = 1;
}
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
}
if ($self->{state_data}->{players}->[0]->{removed} or $self->{state_data}->{players}->[1]->{removed}) {
$self->{current_state} = 'gameover';
}
if ($self->{state_data}->{players}->[0]->{removed} or $self->{state_data}->{players}->[1]->{removed}) { $self->{current_state} = 'gameover'; }
}
my $state_data = $self->{state_data};
@ -484,9 +429,7 @@ sub run_one_state {
}
# dump new state data for logging/debugging
if ($self->{debug} and $state_data->{newstate}) {
$self->{pbot}->{logger}->log("Battleship: New state: $self->{current_state}\n" . Dumper $state_data);
}
if ($self->{debug} and $state_data->{newstate}) { $self->{pbot}->{logger}->log("Battleship: New state: $self->{current_state}\n" . Dumper $state_data); }
# run one state/tick
$state_data = $self->{states}{$self->{current_state}}{sub}($state_data);
@ -555,9 +498,7 @@ sub init_game {
$self->{N_Y} = 8;
$self->{SHIPS} = 6;
for (my $x = 0; $x < $self->{SHIPS}; $x++) {
$self->{ship_length}->[$x] = 0;
}
for (my $x = 0; $x < $self->{SHIPS}; $x++) { $self->{ship_length}->[$x] = 0; }
$self->{board} = [];
@ -581,13 +522,9 @@ sub count_ship_sections {
for ($x = 0; $x < $self->{N_Y}; $x++) {
for ($y = 0; $y < $self->{N_X}; $y++) {
if ($player == 0) {
if ($self->{board}->[$x][$y] eq $self->{player_two_vert} || $self->{board}->[$x][$y] eq $self->{player_two_horiz}) {
$sections++;
}
if ($self->{board}->[$x][$y] eq $self->{player_two_vert} || $self->{board}->[$x][$y] eq $self->{player_two_horiz}) { $sections++; }
} else {
if ($self->{board}->[$x][$y] eq $self->{player_one_vert} || $self->{board}->[$x][$y] eq $self->{player_one_horiz}) {
$sections++;
}
if ($self->{board}->[$x][$y] eq $self->{player_one_vert} || $self->{board}->[$x][$y] eq $self->{player_one_horiz}) { $sections++; }
}
}
}
@ -620,9 +557,7 @@ sub check_ship {
}
for (my $i = 0; $i < $l; $i++) {
if ($self->{board}->[$x += $o ? $xd : 0][$y += $o ? 0 : $yd] ne '~') {
return 0;
}
if ($self->{board}->[$x += $o ? $xd : 0][$y += $o ? 0 : $yd] ne '~') { return 0; }
}
return 1;
@ -646,35 +581,27 @@ sub generate_ship {
$o = $self->number(1, 10) < 6;
$d = $self->number(1, 10) < 6;
if (not $self->{ship_length}->[$ship]) {
$l = $self->number(3, 6);
} else {
$l = $self->{ship_length}->[$ship];
}
if (not $self->{ship_length}->[$ship]) { $l = $self->number(3, 6); }
else { $l = $self->{ship_length}->[$ship]; }
$self->{pbot}->{logger}->log("generate ships player $player: ship $ship x,y: $x,$y o,d: $o,$d length: $l\n");
if ($self->check_ship($x, $y, $o, $d, $l)) {
if (!$o) {
if ($self->{horiz} < 2) { next; }
if (!$d) {
$yd = -1;
} else {
$yd = 1;
}
if (!$d) { $yd = -1; }
else { $yd = 1; }
$xd = 0;
} else {
$self->{horiz}++;
if (!$d) {
$xd = -1;
} else {
$xd = 1;
}
if (!$d) { $xd = -1; }
else { $xd = 1; }
$yd = 0;
}
for (my $i = 0; $i < $l; $i++) {
$self->{board}->[$x += $o ? $xd : 0][$y += $o ? 0 : $yd] = $player ? ($o ? $self->{player_two_vert} : $self->{player_two_horiz}) : ($o ? $self->{player_one_vert} : $self->{player_one_horiz});
$self->{board}->[$x += $o ? $xd : 0][$y += $o ? 0 : $yd] =
$player ? ($o ? $self->{player_two_vert} : $self->{player_two_horiz}) : ($o ? $self->{player_one_vert} : $self->{player_one_horiz});
}
$self->{ship_length}->[$ship] = $l;
@ -695,15 +622,11 @@ sub generate_battlefield {
my ($x, $y);
for ($y = 0; $y < $self->{N_Y}; $y++) {
for ($x = 0; $x < $self->{N_X}; $x++) {
$self->{board}->[$y][$x] = '~';
}
for ($x = 0; $x < $self->{N_X}; $x++) { $self->{board}->[$y][$x] = '~'; }
}
for ($x = 0; $x < $self->{SHIPS}; $x++) {
if (!$self->generate_ship(0, $x) || !$self->generate_ship(1, $x)) {
return 0;
}
if (!$self->generate_ship(0, $x) || !$self->generate_ship(1, $x)) { return 0; }
}
return 1;
}
@ -717,23 +640,15 @@ sub check_sunk {
given ($target) {
when ($_ eq $self->{player_two_vert} or $_ eq $self->{player_one_vert}) {
for ($i = $x + 1; $i < $self->{N_Y}; $i++) {
if (($self->{board}->[$i][$y] eq $self->{player_one_vert} && $player) || ($self->{board}->[$i][$y] eq $self->{player_two_vert} && !$player)) {
return 0;
}
if (($self->{board}->[$i][$y] eq $self->{player_one_vert} && $player) || ($self->{board}->[$i][$y] eq $self->{player_two_vert} && !$player)) { return 0; }
if ($self->{board}->[$i][$y] eq '~' || $self->{board}->[$i][$y] eq '*' || $self->{board}->[$i][$y] eq 'o') {
last;
}
if ($self->{board}->[$i][$y] eq '~' || $self->{board}->[$i][$y] eq '*' || $self->{board}->[$i][$y] eq 'o') { last; }
}
for ($i = $x - 1; $i >= 0; $i--) {
if (($self->{board}->[$i][$y] eq $self->{player_one_vert} && $player) || ($self->{board}->[$i][$y] eq $self->{player_two_vert} && !$player)) {
return 0;
}
if (($self->{board}->[$i][$y] eq $self->{player_one_vert} && $player) || ($self->{board}->[$i][$y] eq $self->{player_two_vert} && !$player)) { return 0; }
if ($self->{board}->[$i][$y] eq '~' || $self->{board}->[$i][$y] eq '*' || $self->{board}->[$i][$y] eq 'o') {
last;
}
if ($self->{board}->[$i][$y] eq '~' || $self->{board}->[$i][$y] eq '*' || $self->{board}->[$i][$y] eq 'o') { last; }
}
return 1;
@ -741,23 +656,15 @@ sub check_sunk {
when ($_ eq $self->{player_one_horiz} or $_ eq $self->{player_two_horiz}) {
for ($i = $y + 1; $i < $self->{N_X}; $i++) {
if (($self->{board}->[$x][$i] eq $self->{player_one_horiz} && $player) || ($self->{board}->[$x][$i] eq $self->{player_two_horiz} && !$player)) {
return 0;
}
if (($self->{board}->[$x][$i] eq $self->{player_one_horiz} && $player) || ($self->{board}->[$x][$i] eq $self->{player_two_horiz} && !$player)) { return 0; }
if ($self->{board}->[$x][$i] eq '~' || $self->{board}->[$x][$i] eq '*' || $self->{board}->[$x][$i] eq 'o') {
last;
}
if ($self->{board}->[$x][$i] eq '~' || $self->{board}->[$x][$i] eq '*' || $self->{board}->[$x][$i] eq 'o') { last; }
}
for ($i = $y - 1; $i >= 0; $i--) {
if (($self->{board}->[$x][$i] eq $self->{player_one_horiz} && $player) || ($self->{board}->[$x][$i] eq $self->{player_two_horiz} && !$player)) {
return 0;
}
if (($self->{board}->[$x][$i] eq $self->{player_one_horiz} && $player) || ($self->{board}->[$x][$i] eq $self->{player_two_horiz} && !$player)) { return 0; }
if ($self->{board}->[$x][$i] eq '~' || $self->{board}->[$x][$i] eq '*' || $self->{board}->[$x][$i] eq 'o') {
last;
}
if ($self->{board}->[$x][$i] eq '~' || $self->{board}->[$x][$i] eq '*' || $self->{board}->[$x][$i] eq 'o') { last; }
}
return 1;
@ -774,7 +681,7 @@ sub bomb {
($x) = $location =~ m/^(.)/;
($y) = $location =~ m/^.(.*)/;
$x = ord($x) - 65;;
$x = ord($x) - 65;
$self->{pbot}->{logger}->log("bomb player $player $x,$y $self->{board}->[$x][$y]\n");
@ -786,31 +693,21 @@ sub bomb {
$y--;
if (!$player) {
if ($self->{board}->[$x][$y] eq $self->{player_two_vert} || $self->{board}->[$x][$y] eq $self->{player_two_horiz}) {
$hit = 1;
}
if ($self->{board}->[$x][$y] eq $self->{player_two_vert} || $self->{board}->[$x][$y] eq $self->{player_two_horiz}) { $hit = 1; }
} else {
if ($self->{board}->[$x][$y] eq $self->{player_one_vert} || $self->{board}->[$x][$y] eq $self->{player_one_horiz}) {
$hit = 1;
}
if ($self->{board}->[$x][$y] eq $self->{player_one_vert} || $self->{board}->[$x][$y] eq $self->{player_one_horiz}) { $hit = 1; }
}
$sunk = $self->check_sunk($x, $y, $player);
if ($hit) {
if (!$player) {
$self->{board}->[$x][$y] = '1';
} else {
$self->{board}->[$x][$y] = '2';
}
if (!$player) { $self->{board}->[$x][$y] = '1'; }
else { $self->{board}->[$x][$y] = '2'; }
$self->{player}->[$player]->{hit}++;
} else {
if ($self->{board}->[$x][$y] eq '~') {
if (!$player) {
$self->{board}->[$x][$y] = '*';
} else {
$self->{board}->[$x][$y] = 'o';
}
if (!$player) { $self->{board}->[$x][$y] = '*'; }
else { $self->{board}->[$x][$y] = 'o'; }
$self->{player}->[$player]->{miss}++;
}
}
@ -818,8 +715,10 @@ sub bomb {
my $nick1 = $self->{player}->[$player]->{nick};
my $nick2 = $self->{player}->[$player ? 0 : 1]->{nick};
my @attacks = ("launches torpedoes at", "launches nukes at", "fires cannons at", "fires torpedoes at", "fires nukes at",
"launches tomahawk missiles at", "fires a gatling gun at", "launches ballistic missiles at");
my @attacks = (
"launches torpedoes at", "launches nukes at", "fires cannons at", "fires torpedoes at", "fires nukes at",
"launches tomahawk missiles at", "fires a gatling gun at", "launches ballistic missiles at"
);
my $attacked = $attacks[rand @attacks];
if ($hit) {
@ -844,6 +743,7 @@ sub bomb {
}
sub show_scoreboard {
my ($self) = @_;
my $buf;
@ -883,15 +783,19 @@ sub show_scoreboard {
my $p2sunkcolor = $self->{player}->[0]->{sunk} < $self->{player}->[1]->{sunk} ? $color{green} : $color{red};
my $p2intactcolor = $p1sections < $p2sections ? $color{green} : $color{red};
$buf = sprintf("$p1win%*s$color{reset}: bomb: $p1bombscolor%*d$color{reset}, hit: $p1hitcolor%*d$color{reset}, miss: $p1misscolor%*d$color{reset}, sunk: $p1sunkcolor%*d$color{reset}, sections left: $p1intactcolor%*d$color{reset}",
$buf = sprintf(
"$p1win%*s$color{reset}: bomb: $p1bombscolor%*d$color{reset}, hit: $p1hitcolor%*d$color{reset}, miss: $p1misscolor%*d$color{reset}, sunk: $p1sunkcolor%*d$color{reset}, sections left: $p1intactcolor%*d$color{reset}",
$longest, $self->{player}->[0]->{nick}, $bombslen, $self->{player}->[0]->{bombs},
$hitlen, $self->{player}->[0]->{hit}, $misslen, $self->{player}->[0]->{miss},
$sunklen, $self->{player}->[0]->{sunk}, $intactlen, $p1sections);
$sunklen, $self->{player}->[0]->{sunk}, $intactlen, $p1sections
);
$self->send_message($self->{channel}, $buf);
$buf = sprintf("$p2win%*s$color{reset}: bomb: $p2bombscolor%*d$color{reset}, hit: $p2hitcolor%*d$color{reset}, miss: $p2misscolor%*d$color{reset}, sunk: $p2sunkcolor%*d$color{reset}, sections left: $p2intactcolor%*d$color{reset}",
$buf = sprintf(
"$p2win%*s$color{reset}: bomb: $p2bombscolor%*d$color{reset}, hit: $p2hitcolor%*d$color{reset}, miss: $p2misscolor%*d$color{reset}, sunk: $p2sunkcolor%*d$color{reset}, sections left: $p2intactcolor%*d$color{reset}",
$longest, $self->{player}->[1]->{nick}, $bombslen, $self->{player}->[1]->{bombs},
$hitlen, $self->{player}->[1]->{hit}, $misslen, $self->{player}->[1]->{miss},
$sunklen, $self->{player}->[1]->{sunk}, $intactlen, $p2sections);
$sunklen, $self->{player}->[1]->{sunk}, $intactlen, $p2sections
);
$self->send_message($self->{channel}, $buf);
}
@ -925,11 +829,9 @@ sub show_battlefield {
$buf .= "$color{blue},01~ ";
next;
} else {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') {
$buf .= "$color{red},01";
} elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') {
$buf .= "$color{cyan},01";
} elsif ($self->{board}->[$y][$x] eq '~') {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') { $buf .= "$color{red},01"; }
elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') { $buf .= "$color{cyan},01"; }
elsif ($self->{board}->[$y][$x] eq '~') {
$buf .= "$color{blue},01~ ";
next;
} else {
@ -943,11 +845,9 @@ sub show_battlefield {
$buf .= "$color{blue},01~ ";
next;
} else {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') {
$buf .= "$color{red},01";
} elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') {
$buf .= "$color{cyan},01";
} elsif ($self->{board}->[$y][$x] eq '~') {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') { $buf .= "$color{red},01"; }
elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') { $buf .= "$color{cyan},01"; }
elsif ($self->{board}->[$y][$x] eq '~') {
$buf .= "$color{blue},01~ ";
next;
} else {
@ -956,16 +856,17 @@ sub show_battlefield {
$buf .= "$self->{board}->[$y][$x] ";
}
} elsif ($player == 2) {
if ($self->{board}->[$y][$x] eq $self->{player_one_vert} || $self->{board}->[$y][$x] eq $self->{player_one_horiz}
|| $self->{board}->[$y][$x] eq $self->{player_two_vert} || $self->{board}->[$y][$x] eq $self->{player_two_horiz}) {
if ( $self->{board}->[$y][$x] eq $self->{player_one_vert}
|| $self->{board}->[$y][$x] eq $self->{player_one_horiz}
|| $self->{board}->[$y][$x] eq $self->{player_two_vert}
|| $self->{board}->[$y][$x] eq $self->{player_two_horiz})
{
$buf .= "$color{blue},01~ ";
next;
} else {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') {
$buf .= "$color{red},01";
} elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') {
$buf .= "$color{cyan},01";
} elsif ($self->{board}->[$y][$x] eq '~') {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') { $buf .= "$color{red},01"; }
elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') { $buf .= "$color{cyan},01"; }
elsif ($self->{board}->[$y][$x] eq '~') {
$buf .= "$color{blue},01~ ";
next;
} else {
@ -974,11 +875,9 @@ sub show_battlefield {
$buf .= "$self->{board}->[$y][$x] ";
}
} else {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') {
$buf .= "$color{red},01";
} elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') {
$buf .= "$color{cyan},01";
} elsif ($self->{board}->[$y][$x] eq '~') {
if ($self->{board}->[$y][$x] eq '1' || $self->{board}->[$y][$x] eq '2') { $buf .= "$color{red},01"; }
elsif ($self->{board}->[$y][$x] eq 'o' || $self->{board}->[$y][$x] eq '*') { $buf .= "$color{cyan},01"; }
elsif ($self->{board}->[$y][$x] eq '~') {
$buf .= "$color{blue},01~ ";
next;
} else {
@ -1012,25 +911,46 @@ sub show_battlefield {
my $player2 = $self->{player}->[1]->{nick};
if ($player == 0) {
$self->send_message($self->{player}->[$player]->{nick}, "Player One Legend: ships: [| -] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"."1"."$color{reset}] $player2 hit: [$color{red},012$color{reset}]");
$self->send_message(
$self->{player}->[$player]->{nick},
"Player One Legend: ships: [| -] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"
. "1"
. "$color{reset}] $player2 hit: [$color{red},012$color{reset}]"
);
} elsif ($player == 1) {
$self->send_message($self->{player}->[$player]->{nick}, "Player Two Legend: ships: [I =] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"."1"."$color{reset}] $player2 hit: [$color{red},012$color{reset}]");
$self->send_message(
$self->{player}->[$player]->{nick},
"Player Two Legend: ships: [I =] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"
. "1"
. "$color{reset}] $player2 hit: [$color{red},012$color{reset}]"
);
} elsif ($player == 2) {
$self->send_message($self->{channel}, "Spectator Legend: ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"."1"."$color{reset}] $player2 hit: [$color{red},012$color{reset}]");
$self->send_message(
$self->{channel},
"Spectator Legend: ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"
. "1"
. "$color{reset}] $player2 hit: [$color{red},012$color{reset}]"
);
} elsif ($player == 3) {
$self->send_message($self->{channel}, "Final Board Legend: $player1 ships: [| -] $player2 ships: [I =] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"."1"."$color{reset}] $player2 hit: [$color{red},012$color{reset}]");
$self->send_message(
$self->{channel},
"Final Board Legend: $player1 ships: [| -] $player2 ships: [I =] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"
. "1"
. "$color{reset}] $player2 hit: [$color{red},012$color{reset}]"
);
} else {
$self->send_message($nick, "Full Board Legend: $player1 ships: [| -] $player2 ships: [I =] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"."1"."$color{reset}] $player2 hit: [$color{red},012$color{reset}]");
$self->send_message(
$nick,
"Full Board Legend: $player1 ships: [| -] $player2 ships: [I =] ocean: [$color{blue},01~$color{reset}] $player1 miss: [$color{cyan},01*$color{reset}] $player2 miss: [$color{cyan},01o$color{reset}] $player1 hit: [$color{red},01"
. "1"
. "$color{reset}] $player2 hit: [$color{red},012$color{reset}]"
);
}
foreach my $line (split /\n/, $buf) {
if ($player == 0 || $player == 1) {
$self->send_message($self->{player}->[$player]->{nick}, $line);
} elsif ($player == 2 || $player == 3) {
$self->send_message($self->{channel}, $line);
} else {
$self->send_message($nick, $line);
}
if ($player == 0 || $player == 1) { $self->send_message($self->{player}->[$player]->{nick}, $line); }
elsif ($player == 2 || $player == 3) { $self->send_message($self->{channel}, $line); }
else { $self->send_message($nick, $line); }
}
}
@ -1058,11 +978,8 @@ sub accept {
$state->{tocked} = 1;
if (++$state->{counter} > $state->{max_count}) {
if ($state->{players}->[1]->{id} == -1) {
$self->send_message($self->{channel}, "Nobody has accepted $state->{players}->[0]->{name}'s challenge.");
} else {
$self->send_message($self->{channel}, "$state->{players}->[1]->{name} has failed to accept $state->{players}->[0]->{name}'s challenge.");
}
if ($state->{players}->[1]->{id} == -1) { $self->send_message($self->{channel}, "Nobody has accepted $state->{players}->[0]->{name}'s challenge."); }
else { $self->send_message($self->{channel}, "$state->{players}->[1]->{name} has failed to accept $state->{players}->[0]->{name}'s challenge."); }
$state->{result} = 'stop';
$state->{players} = [];
return $state;
@ -1103,11 +1020,8 @@ sub playermove {
my ($self, $state) = @_;
my $tock;
if ($state->{first_tock}) {
$tock = 3;
} else {
$tock = 15;
}
if ($state->{first_tock}) { $tock = 3; }
else { $tock = 15; }
if ($self->{player}->[$state->{current_player}]->{done}) {
$self->{pbot}->{logger}->log("playermove: player $state->{current_player} done, nexting\n");
@ -1156,11 +1070,8 @@ sub playermove {
sub checkplayer {
my ($self, $state) = @_;
if ($self->{player}->[0]->{won} or $self->{player}->[1]->{won}) {
$state->{result} = 'sunk';
} else {
$state->{result} = 'next';
}
if ($self->{player}->[0]->{won} or $self->{player}->[1]->{won}) { $state->{result} = 'sunk'; }
else { $state->{result} = 'next'; }
return $state;
}

202
Plugins/Connect4.pm
View File

@ -98,9 +98,7 @@ sub parse_challenge {
my ($conns, $xy, $nx, $ny);
"x" =~ /x/; # clear $1, $2 ...
if ($options !~ m/^(\d+)(:(\d+)x(\d+))?$/) {
return "Invalid options '$options', use: <CONNS:ROWSxCOLS>";
}
if ($options !~ m/^(\d+)(:(\d+)x(\d+))?$/) { return "Invalid options '$options', use: <CONNS:ROWSxCOLS>"; }
$conns = $1;
$xy = $2;
@ -118,13 +116,11 @@ sub parse_challenge {
}
if ($self->{N_X} > $MAX_NX || $self->{N_Y} > $MAX_NY) {
return "Invalid board options '$self->{CONNECTIONS}:$self->{N_Y}x$self->{N_X}', " .
"maximum board size is: ${MAX_NY}x${MAX_NX}.";
return "Invalid board options '$self->{CONNECTIONS}:$self->{N_Y}x$self->{N_X}', " . "maximum board size is: ${MAX_NY}x${MAX_NX}.";
}
if ($self->{N_X} < $self->{CONNECTIONS} && $self->{N_Y} < $self->{CONNECTIONS}) {
return "Invalid board options '$self->{CONNECTIONS}:$self->{N_Y}x$self->{N_X}', " .
"rows or columns must be >= than connections.";
return "Invalid board options '$self->{CONNECTIONS}:$self->{N_Y}x$self->{N_X}', " . "rows or columns must be >= than connections.";
}
return 0;
@ -146,28 +142,19 @@ sub connect4_cmd {
given ($command) {
when ('help') {
given ($arguments) {
when ('help') {
return "Seriously?";
}
when ('help') { return "Seriously?"; }
when ('challenge') {
return "challenge [nick] [connections[:ROWSxCOLS]] -- connections has to be <= than rows or columns (duh!).";
}
when ('challenge') { return "challenge [nick] [connections[:ROWSxCOLS]] -- connections has to be <= than rows or columns (duh!)."; }
default {
if (length $arguments) {
return "connect4 has no such command '$arguments'. I can't help you with that.";
} else {
return "Usage: connect4 help <command>";
}
if (length $arguments) { return "connect4 has no such command '$arguments'. I can't help you with that."; }
else { return "Usage: connect4 help <command>"; }
}
}
}
when ('challenge') {
if ($self->{current_state} ne 'nogame') {
return "There is already a game of connect4 underway.";
}
if ($self->{current_state} ne 'nogame') { return "There is already a game of connect4 underway."; }
$self->{N_X} = $DEFAULT_NX;
$self->{N_Y} = $DEFAULT_NY;
@ -183,27 +170,21 @@ sub connect4_cmd {
$player = {id => -1, name => undef, missedinputs => 0};
push @{$self->{state_data}->{players}}, $player;
return "/msg $self->{channel} $nick has made an open challenge (Connect-$self->{CONNECTIONS} @ " .
"$self->{N_Y}x$self->{N_X} board)! Use `accept` to accept their challenge.";
return "/msg $self->{channel} $nick has made an open challenge (Connect-$self->{CONNECTIONS} @ "
. "$self->{N_Y}x$self->{N_X} board)! Use `accept` to accept their challenge.";
}
if ($err) {
return $err;
}
if ($err) { return $err; }
my $challengee = $self->{pbot}->{nicklist}->is_present($self->{channel}, $arguments);
if (not $challengee) {
return "That nick is not present in this channel. Invite them to $self->{channel} and try again!";
}
if (not $challengee) { return "That nick is not present in this channel. Invite them to $self->{channel} and try again!"; }
$self->{current_state} = 'accept';
$self->{state_data} = {players => [], counter => 0};
if (length $options) {
if ($err = $self->parse_challenge($options)) {
return $err;
}
if ($err = $self->parse_challenge($options)) { return $err; }
}
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
@ -214,14 +195,12 @@ sub connect4_cmd {
$player = {id => $id, name => $challengee, missedinputs => 0};
push @{$self->{state_data}->{players}}, $player;
return "/msg $self->{channel} $nick has challenged $challengee to " .
"Connect-$self->{CONNECTIONS} @ $self->{N_Y}x$self->{N_X} board! Use `accept` to accept their challenge.";
return "/msg $self->{channel} $nick has challenged $challengee to "
. "Connect-$self->{CONNECTIONS} @ $self->{N_Y}x$self->{N_X} board! Use `accept` to accept their challenge.";
}
when ('accept') {
if ($self->{current_state} ne 'accept') {
return "/msg $nick This is not the time to use `accept`.";
}
if ($self->{current_state} ne 'accept') { return "/msg $nick This is not the time to use `accept`."; }
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
my $player = $self->{state_data}->{players}->[1];
@ -252,9 +231,7 @@ sub connect4_cmd {
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
return "/msg $self->{channel} $nick has left the game!";
} else {
return "$nick: But you are not even playing the game.";
@ -262,32 +239,22 @@ sub connect4_cmd {
}
when ('abort') {
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) {
return "$nick: Sorry, only admins may abort the game.";
}
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) { return "$nick: Sorry, only admins may abort the game."; }
$self->{current_state} = 'gameover';
return "/msg $self->{channel} $nick: The game has been aborted.";
}
when ('players') {
if ($self->{current_state} eq 'accept') {
return "$self->{state_data}->{players}->[0]->{name} has challenged $self->{state_data}->{players}->[1]->{name}!";
} elsif (@{$self->{state_data}->{players}} == 2) {
return "$self->{state_data}->{players}->[0]->{name} is playing with $self->{state_data}->{players}->[1]->{name}!";
} else {
return "There are no players playing right now. Start a game with `connect4 challenge <nick>`!";
}
if ($self->{current_state} eq 'accept') { return "$self->{state_data}->{players}->[0]->{name} has challenged $self->{state_data}->{players}->[1]->{name}!"; }
elsif (@{$self->{state_data}->{players}} == 2) { return "$self->{state_data}->{players}->[0]->{name} is playing with $self->{state_data}->{players}->[1]->{name}!"; }
else { return "There are no players playing right now. Start a game with `connect4 challenge <nick>`!"; }
}
when ('kick') {
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) {
return "$nick: Sorry, only admins may kick people from the game.";
}
if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, "$nick!$user\@$host")) { return "$nick: Sorry, only admins may kick people from the game."; }
if (not length $arguments) {
return "Usage: connect4 kick <nick>";
}
if (not length $arguments) { return "Usage: connect4 kick <nick>"; }
my $removed = 0;
@ -299,9 +266,7 @@ sub connect4_cmd {
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
return "/msg $self->{channel} $nick: $arguments has been kicked from the game.";
} else {
return "$nick: $arguments isn't even in the game.";
@ -309,36 +274,22 @@ sub connect4_cmd {
}
when ('play') {
if ($self->{debug}) {
$self->{pbot}->{logger}->log("Connect4: play state: $self->{current_state}\n" . Dumper $self->{state_data});
}
if ($self->{debug}) { $self->{pbot}->{logger}->log("Connect4: play state: $self->{current_state}\n" . Dumper $self->{state_data}); }
if ($self->{current_state} ne 'playermove') {
return "$nick: It's not time to do that now.";
}
if ($self->{current_state} ne 'playermove') { return "$nick: It's not time to do that now."; }
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
my $player;
if ($self->{state_data}->{players}->[0]->{id} == $id) {
$player = 0;
} elsif ($self->{state_data}->{players}->[1]->{id} == $id) {
$player = 1;
} else {
return "You are not playing in this game.";
}
if ($self->{state_data}->{players}->[0]->{id} == $id) { $player = 0; }
elsif ($self->{state_data}->{players}->[1]->{id} == $id) { $player = 1; }
else { return "You are not playing in this game."; }
if ($self->{state_data}->{current_player} != $player) {
return "$nick: It is not your turn to attack!";
}
if ($self->{state_data}->{current_player} != $player) { return "$nick: It is not your turn to attack!"; }
if ($self->{player}->[$player]->{done}) {
return "$nick: You have already played this turn.";
}
if ($self->{player}->[$player]->{done}) { return "$nick: You have already played this turn."; }
if ($arguments !~ m/^\d+$/) {
return "$nick: Usage: connect4 play <location>; <location> must be in the [1, $self->{N_X}] range.";
}
if ($arguments !~ m/^\d+$/) { return "$nick: Usage: connect4 play <location>; <location> must be in the [1, $self->{N_X}] range."; }
if ($self->play($player, uc $arguments)) {
if ($self->{player}->[$player]->{won}) {
@ -357,8 +308,7 @@ sub connect4_cmd {
}
when ('board') {
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept'
or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept' or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
return "$nick: There is no board to show right now.";
}
@ -374,9 +324,7 @@ sub connect4_cmd {
$self->show_board;
}
default {
return $usage;
}
default { return $usage; }
}
return $result;
@ -402,9 +350,7 @@ sub player_left {
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
return "/msg $self->{channel} $nick has left the game!";
}
}
@ -428,16 +374,17 @@ sub run_one_state {
my $removed = 0;
for (my $i = 0; $i < @{$self->{state_data}->{players}}; $i++) {
if ($self->{state_data}->{players}->[$i]->{missedinputs} >= 3) {
$self->send_message($self->{channel}, "$color{red}$self->{state_data}->{players}->[$i]->{name} has missed too many prompts and has been ejected from the game!$color{reset}");
$self->send_message(
$self->{channel},
"$color{red}$self->{state_data}->{players}->[$i]->{name} has missed too many prompts and has been ejected from the game!$color{reset}"
);
splice @{$self->{state_data}->{players}}, $i--, 1;
$removed = 1;
}
}
if ($removed) {
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) {
$self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1
}
if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 }
}
if (not @{$self->{state_data}->{players}} == 2) {
@ -472,9 +419,7 @@ sub run_one_state {
}
# dump new state data for logging/debugging
if ($self->{debug} and $state_data->{newstate}) {
$self->{pbot}->{logger}->log("Connect4: New state: $self->{current_state}\n" . Dumper $state_data);
}
if ($self->{debug} and $state_data->{newstate}) { $self->{pbot}->{logger}->log("Connect4: New state: $self->{current_state}\n" . Dumper $state_data); }
# run one state/tick
$state_data = $self->{states}{$self->{current_state}}{sub}($state_data);
@ -561,9 +506,7 @@ sub generate_board {
my ($x, $y);
for ($y = 0; $y < $self->{N_Y}; $y++) {
for ($x = 0; $x < $self->{N_X}; $x++) {
$self->{board}->[$y][$x] = ' ';
}
for ($x = 0; $x < $self->{N_X}; $x++) { $self->{board}->[$y][$x] = ' '; }
}
}
@ -573,9 +516,7 @@ sub check_one {
push @{$self->{winner_line}}, "$y $x";
if ($chip eq ' ' || $chip ne $prev) {
$self->{winner_line} = ($chip eq ' ') ? [] : [ "$y $x" ];
}
if ($chip eq ' ' || $chip ne $prev) { $self->{winner_line} = ($chip eq ' ') ? [] : ["$y $x"]; }
return (scalar @{$self->{winner_line}} == $self->{CONNECTIONS}, $chip);
}
@ -590,9 +531,7 @@ sub connected {
$self->{winner_line} = [];
for ($i = $row, $j = $self->{N_X} - 1; $i < $self->{N_Y} && $j >= 0; $i++, $j--) {
($rv, $prev) = $self->check_one($i, $j, $prev);
if ($rv) {
return 1;
}
if ($rv) { return 1; }
}
}
@ -601,9 +540,7 @@ sub connected {
$self->{winner_line} = [];
for ($i = 0, $j = $col; $i < $self->{N_Y} && $j >= 0; $i++, $j--) {
($rv, $prev) = $self->check_one($i, $j, $prev);
if ($rv) {
return 2;
}
if ($rv) { return 2; }
}
}
@ -612,9 +549,7 @@ sub connected {
$self->{winner_line} = [];
for ($i = $row, $j = 0; $i < $self->{N_Y}; $i++, $j++) {
($rv, $prev) = $self->check_one($i, $j, $prev);
if ($rv) {
return 3;
}
if ($rv) { return 3; }
}
}
@ -623,9 +558,7 @@ sub connected {
$self->{winner_line} = [];
for ($i = 0, $j = $col; $i < $self->{N_Y} && $j < $self->{N_X}; $i++, $j++) {
($rv, $prev) = $self->check_one($i, $j, $prev);
if ($rv) {
return 4;
}
if ($rv) { return 4; }
}
}
@ -634,9 +567,7 @@ sub connected {
$self->{winner_line} = [];
for ($col = 0; $col < $self->{N_X}; $col++) {
($rv, $prev) = $self->check_one($row, $col, $prev);
if ($rv) {
return 5;
}
if ($rv) { return 5; }
}
}
@ -645,9 +576,7 @@ sub connected {
$self->{winner_line} = [];
for ($row = $self->{N_Y} - 1; $row >= 0; $row--) {
($rv, $prev) = $self->check_one($row, $col, $prev);
if ($rv) {
return 6;
}
if ($rv) { return 6; }
}
}
@ -660,9 +589,7 @@ sub column_top {
my $y;
for ($y = 0; $y < $self->{N_Y}; $y++) {
if ($self->{board}->[$y][$x] ne ' ') {
return $y - 1;
}
if ($self->{board}->[$y][$x] ne ' ') { return $y - 1; }
}
return -1; # shouldnt happen
}
@ -738,9 +665,7 @@ sub show_board {
my $rc = "$y $x";
$c = $chip eq 'O' ? $color{red} : $color{yellow};
if (grep(/^$rc$/, @{$self->{winner_line}})) {
$c .= $color{bold};
}
if (grep(/^$rc$/, @{$self->{winner_line}})) { $c .= $color{bold}; }
$buf .= $color{blue} . "[";
$buf .= $c . $chip . $color{reset};
@ -751,9 +676,7 @@ sub show_board {
$buf .= "\n";
}
foreach my $line (split /\n/, $buf) {
$self->send_message($self->{channel}, $line);
}
foreach my $line (split /\n/, $buf) { $self->send_message($self->{channel}, $line); }
}
# state subroutines
@ -780,11 +703,8 @@ sub accept {
$state->{tocked} = 1;
if (++$state->{counter} > $state->{max_count}) {
if ($state->{players}->[1]->{id} == -1) {
$self->send_message($self->{channel}, "Nobody has accepted $state->{players}->[0]->{name}'s challenge.");
} else {
$self->send_message($self->{channel}, "$state->{players}->[1]->{name} has failed to accept $state->{players}->[0]->{name}'s challenge.");
}
if ($state->{players}->[1]->{id} == -1) { $self->send_message($self->{channel}, "Nobody has accepted $state->{players}->[0]->{name}'s challenge."); }
else { $self->send_message($self->{channel}, "$state->{players}->[1]->{name} has failed to accept $state->{players}->[0]->{name}'s challenge."); }
$state->{result} = 'stop';
$state->{players} = [];
return $state;
@ -822,11 +742,8 @@ sub playermove {
my ($self, $state) = @_;
my $tock;
if ($state->{first_tock}) {
$tock = 3;
} else {
$tock = 15;
}
if ($state->{first_tock}) { $tock = 3; }
else { $tock = 15; }
if ($self->{player}->[$state->{current_player}]->{done}) {
$self->{pbot}->{logger}->log("playermove: player $state->{current_player} done, nexting\n");
@ -862,11 +779,8 @@ sub playermove {
sub checkplayer {
my ($self, $state) = @_;
if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) {
$state->{result} = 'end';
} else {
$state->{result} = 'next';
}
if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) { $state->{result} = 'end'; }
else { $state->{result} = 'next'; }
return $state;
}

161
Plugins/Counter.pm
View File

@ -47,7 +47,8 @@ sub create_database {
my $self = shift;
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1 }) or die $DBI::errstr;
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
or die $DBI::errstr;
$self->{dbh}->do(<<SQL);
CREATE TABLE IF NOT EXISTS Counters (
@ -77,9 +78,7 @@ SQL
sub dbi_begin {
my ($self) = @_;
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1 }) or die $DBI::errstr;
};
eval { $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1}) or die $DBI::errstr; };
if ($@) {
$self->{pbot}->{logger}->log("Error opening Counters database: $@");
@ -98,9 +97,7 @@ sub add_counter {
my ($self, $owner, $channel, $name, $description) = @_;
my ($desc, $timestamp) = $self->get_counter($channel, $name);
if (defined $desc) {
return 0;
}
if (defined $desc) { return 0; }
eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Counters (channel, name, description, timestamp, created_on, created_by, counter) VALUES (?, ?, ?, ?, ?, ?, ?)');
@ -125,9 +122,7 @@ sub reset_counter {
my ($self, $channel, $name) = @_;
my ($description, $timestamp, $counter) = $self->get_counter($channel, $name);
if (not defined $description) {
return (undef, undef);
}
if (not defined $description) { return (undef, undef); }
eval {
my $sth = $self->{dbh}->prepare('UPDATE Counters SET timestamp = ?, counter = ? WHERE channel = ? AND name = ?');
@ -149,9 +144,7 @@ sub delete_counter {
my ($self, $channel, $name) = @_;
my ($description, $timestamp) = $self->get_counter($channel, $name);
if (not defined $description) {
return 0;
}
if (not defined $description) { return 0; }
eval {
my $sth = $self->{dbh}->prepare('DELETE FROM Counters WHERE channel = ? AND name = ?');
@ -160,7 +153,6 @@ sub delete_counter {
$sth->execute();
};
if ($@) {
$self->{pbot}->{logger}->log("Delete counter failed: $@");
return 0;
@ -178,9 +170,7 @@ sub list_counters {
return $sth->fetchall_arrayref();
};
if ($@) {
$self->{pbot}->{logger}->log("List counters failed: $@");
}
if ($@) { $self->{pbot}->{logger}->log("List counters failed: $@"); }
return map { $_->[0] } @$counters;
}
@ -207,9 +197,7 @@ sub add_trigger {
my ($self, $channel, $trigger, $target) = @_;
my $exists = $self->get_trigger($channel, $trigger);
if (defined $exists) {
return 0;
}
if (defined $exists) { return 0; }
eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Triggers (channel, trigger, target) VALUES (?, ?, ?)');
@ -230,9 +218,7 @@ sub delete_trigger {
my ($self, $channel, $trigger) = @_;
my $target = $self->get_trigger($channel, $trigger);
if (not defined $target) {
return 0;
}
if (not defined $target) { return 0; }
my $sth = $self->{dbh}->prepare('DELETE FROM Triggers WHERE channel = ? AND trigger = ?');
$sth->bind_param(1, lc $channel);
@ -251,9 +237,7 @@ sub list_triggers {
return $sth->fetchall_arrayref({});
};
if ($@) {
$self->{pbot}->{logger}->log("List triggers failed: $@");
}
if ($@) { $self->{pbot}->{logger}->log("List triggers failed: $@"); }
return @$triggers;
}
@ -289,17 +273,12 @@ sub counteradd {
} else {
$channel = $from;
($name, $description) = split /\s+/, $arguments, 2;
if (not defined $name or not defined $description) {
return "Usage: counteradd <name> <description>";
}
if (not defined $name or not defined $description) { return "Usage: counteradd <name> <description>"; }
}
my $result;
if ($self->add_counter("$nick!$user\@$host", $channel, $name, $description)) {
$result = "Counter added.";
} else {
$result = "Counter '$name' already exists.";
}
if ($self->add_counter("$nick!$user\@$host", $channel, $name, $description)) { $result = "Counter added."; }
else { $result = "Counter '$name' already exists."; }
$self->dbi_end;
return $result;
}
@ -311,23 +290,16 @@ sub counterdel {
if ($from !~ m/^#/) {
($channel, $name) = split /\s+/, $arguments, 2;
if (not defined $channel or not defined $name or $channel !~ m/^#/) {
return "Usage from private message: counterdel <channel> <name>";
}
if (not defined $channel or not defined $name or $channel !~ m/^#/) { return "Usage from private message: counterdel <channel> <name>"; }
} else {
$channel = $from;
($name) = split /\s+/, $arguments, 1;
if (not defined $name) {
return "Usage: counterdel <name>";
}
if (not defined $name) { return "Usage: counterdel <name>"; }
}
my $result;
if ($self->delete_counter($channel, $name)) {
$result = "Counter removed.";
} else {
$result = "No such counter.";
}
if ($self->delete_counter($channel, $name)) { $result = "Counter removed."; }
else { $result = "No such counter."; }
$self->dbi_end;
return $result;
}
@ -339,15 +311,11 @@ sub counterreset {
if ($from !~ m/^#/) {
($channel, $name) = split /\s+/, $arguments, 2;
if (not defined $channel or not defined $name or $channel !~ m/^#/) {
return "Usage from private message: counterreset <channel> <name>";
}
if (not defined $channel or not defined $name or $channel !~ m/^#/) { return "Usage from private message: counterreset <channel> <name>"; }
} else {
$channel = $from;
($name) = split /\s+/, $arguments, 1;
if (not defined $name) {
return "Usage: counterreset <name>";
}
if (not defined $name) { return "Usage: counterreset <name>"; }
}
my $result;
@ -370,15 +338,11 @@ sub countershow {
if ($from !~ m/^#/) {
($channel, $name) = split /\s+/, $arguments, 2;
if (not defined $channel or not defined $name or $channel !~ m/^#/) {
return "Usage from private message: countershow <channel> <name>";
}
if (not defined $channel or not defined $name or $channel !~ m/^#/) { return "Usage from private message: countershow <channel> <name>"; }
} else {
$channel = $from;
($name) = split /\s+/, $arguments, 1;
if (not defined $name) {
return "Usage: countershow <name>";
}
if (not defined $name) { return "Usage: countershow <name>"; }
}
my $result;
@ -401,9 +365,7 @@ sub counterlist {
my $channel;
if ($from !~ m/^#/) {
if (not length $arguments or $arguments !~ m/^#/) {
return "Usage from private message: counterlist <channel>";
}
if (not length $arguments or $arguments !~ m/^#/) { return "Usage from private message: counterlist <channel>"; }
$channel = $arguments;
} else {
$channel = $from;
@ -412,9 +374,8 @@ sub counterlist {
my @counters = $self->list_counters($channel);
my $result;
if (not @counters) {
$result = "No counters available for $channel.";
} else {
if (not @counters) { $result = "No counters available for $channel."; }
else {
my $comma = '';
$result = "Counters for $channel: ";
foreach my $counter (sort @counters) {
@ -437,9 +398,8 @@ sub countertrigger {
given ($command) {
when ('list') {
if ($from =~ m/^#/) {
$channel = $from;
} else {
if ($from =~ m/^#/) { $channel = $from; }
else {
($channel) = split / /, $arguments, 1;
if ($channel !~ m/^#/) {
$self->dbi_end;
@ -449,9 +409,8 @@ sub countertrigger {
my @triggers = $self->list_triggers($channel);
if (not @triggers) {
$result = "No counter triggers set for $channel.";
} else {
if (not @triggers) { $result = "No counter triggers set for $channel."; }
else {
$result = "Triggers for $channel: ";
my $comma = '';
foreach my $trigger (@triggers) {
@ -462,9 +421,8 @@ sub countertrigger {
}
when ('add') {
if ($from =~ m/^#/) {
$channel = $from;
} else {
if ($from =~ m/^#/) { $channel = $from; }
else {
($channel, $arguments) = split / /, $arguments, 2;
if ($channel !~ m/^#/) {
$self->dbi_end;
@ -472,15 +430,11 @@ sub countertrigger {
}
}
my ($trigger, $target) = split / /, $arguments, 2;
if (not defined $trigger or not defined $target) {
if ($from !~ m/^#/) {
$result = "Usage from private message: countertrigger add <channel> <regex> <target>";
} else {
$result = "Usage: countertrigger add <regex> <target>";
}
if ($from !~ m/^#/) { $result = "Usage from private message: countertrigger add <channel> <regex> <target>"; }
else { $result = "Usage: countertrigger add <regex> <target>"; }
$self->dbi_end;
return $result;
}
@ -492,17 +446,13 @@ sub countertrigger {
return "Trigger already exists.";
}
if ($self->add_trigger($channel, $trigger, $target)) {
$result = "Trigger added.";
} else {
$result = "Failed to add trigger.";
}
if ($self->add_trigger($channel, $trigger, $target)) { $result = "Trigger added."; }
else { $result = "Failed to add trigger."; }
}
when ('delete') {
if ($from =~ m/^#/) {
$channel = $from;
} else {
if ($from =~ m/^#/) { $channel = $from; }
else {
($channel, $arguments) = split / /, $arguments, 2;
if ($channel !~ m/^#/) {
$self->dbi_end;
@ -513,28 +463,22 @@ sub countertrigger {
my ($trigger) = split / /, $arguments, 1;
if (not defined $trigger) {
if ($from !~ m/^#/) {
$result = "Usage from private message: countertrigger delete <channel> <regex>";
} else {
$result = "Usage: countertrigger delete <regex>";
}
if ($from !~ m/^#/) { $result = "Usage from private message: countertrigger delete <channel> <regex>"; }
else { $result = "Usage: countertrigger delete <regex>"; }
$self->dbi_end;
return $result;
}
my $target = $self->get_trigger($channel, $trigger);
if (not defined $target) {
$result = "No such trigger.";
} else {
if (not defined $target) { $result = "No such trigger."; }
else {
$self->delete_trigger($channel, $trigger);
$result = "Trigger deleted.";
}
}
default {
$result = "Usage: countertrigger <list/add/delete> [arguments]";
}
default { $result = "Usage: countertrigger <list/add/delete> [arguments]"; }
}
$self->dbi_end;
@ -550,14 +494,10 @@ sub on_public {
if ($self->{pbot}->{ignorelist}->check_ignore($nick, $user, $host, $channel, 1)) {
my $admin = $self->{pbot}->{users}->loggedin_admin($channel, "$nick!$user\@$host");
if (!defined $admin || $admin->{level} < 10) {
return 0;
}
if (!defined $admin || $admin->{level} < 10) { return 0; }
}
if (not $self->dbi_begin) {
return 0;
}
if (not $self->dbi_begin) { return 0; }
my @triggers = $self->list_triggers($channel);
@ -567,17 +507,12 @@ sub on_public {
eval {
my $message;
if ($trigger->{trigger} =~ m/^\^/) {
$message = "$hostmask $msg";
} else {
$message = $msg;
}
if ($trigger->{trigger} =~ m/^\^/) { $message = "$hostmask $msg"; }
else { $message = $msg; }
my $silent = 0;
if ($trigger->{trigger} =~ s/:silent$//i) {
$silent = 1;
}
if ($trigger->{trigger} =~ s/:silent$//i) { $silent = 1; }
if ($message =~ m/$trigger->{trigger}/i) {
my ($desc, $timestamp) = $self->reset_counter($channel, $trigger->{target});
@ -591,9 +526,7 @@ sub on_public {
}
};
if ($@) {
$self->{pbot}->{logger}->log("Skipping bad trigger $trigger->{trigger}: $@");
}
if ($@) { $self->{pbot}->{logger}->log("Skipping bad trigger $trigger->{trigger}: $@"); }
}
$self->dbi_end;
return 0;

7
Plugins/Date.pm
View File

@ -38,7 +38,8 @@ sub datecmd {
Getopt::Long::Configure("bundling");
my ($user_override, $show_usage);
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
'u=s' => \$user_override,
'h' => \$show_usage
);
@ -54,9 +55,7 @@ sub datecmd {
$timezone = $tz_override if $tz_override;
$timezone = $arguments if length $arguments;
if (defined $user_override and not length $tz_override) {
return "No timezone set or user account does not exist.";
}
if (defined $user_override and not length $tz_override) { return "No timezone set or user account does not exist."; }
my $newstuff = {
from => $from, nick => $nick, user => $user, host => $host,

1
Plugins/Example.pm
View File

@ -15,6 +15,7 @@ sub initialize {
sub unload {
my $self = shift;
# perform plugin clean-up here
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
}

4
Plugins/FuncBuiltins.pm
View File

@ -55,7 +55,8 @@ sub initialize {
subref => sub { $self->func_unquote(@_) }
}
);
$self->{pbot}->{functions}->register('uri_escape',
$self->{pbot}->{functions}->register(
'uri_escape',
{
desc => 'percent-encode unsafe URI characters',
usage => 'uri_escape <text>',
@ -110,6 +111,7 @@ sub func_lc {
}
use URI::Escape qw/uri_escape_utf8/;
sub func_uri_escape {
my $self = shift;
my $text = "@_";

15
Plugins/FuncSed.pm
View File

@ -32,6 +32,7 @@ sub unload {
# near-verbatim insertion of krok's `sed` factoid
no warnings;
sub func_sed {
my $self = shift;
my $text = "@_";
@ -43,17 +44,11 @@ sub func_sed {
$r =~ s/^'"(.*)"'$/$1/;
$m =~ s/P//g;
if($g) {
$a =~ s|(?$m)($t)|$1=~/^[A-Z][^A-Z]/?ucfirst$r:($1=~/^[A-Z]+$/?uc$r:$r)|gie;
if ($g) { $a =~ s|(?$m)($t)|$1=~/^[A-Z][^A-Z]/?ucfirst$r:($1=~/^[A-Z]+$/?uc$r:$r)|gie; }
else { $a =~ s|(?$m)($t)|$1=~/^[A-Z][^A-Z]/?ucfirst$r:($1=~/^[A-Z]+$/?uc$r:$r)|ie; }
} else {
$a =~ s|(?$m)($t)|$1=~/^[A-Z][^A-Z]/?ucfirst$r:($1=~/^[A-Z]+$/?uc$r:$r)|ie;
}
} else {
if ($g) {
$a =~ s/(?$m)$t/$r/geee;
} else {
$a=~s/(?$m)$t/$r/eee;
}
if ($g) { $a =~ s/(?$m)$t/$r/geee; }
else { $a =~ s/(?$m)$t/$r/eee; }
}
return $a;
} else {

27
Plugins/GoogleSearch.pm
View File

@ -5,6 +5,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::GoogleSearch;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -43,9 +44,7 @@ sub googlesearch {
return "$nick: Registry item googlesearch.api_key is not set. See https://developers.google.com/custom-search/v1/overview to get an API key.";
}
if (not length $cx) {
return "$nick: Registry item googlesearch.context is not set. See https://cse.google.com/all to set up a context.";
}
if (not length $cx) { return "$nick: Registry item googlesearch.context is not set. See https://cse.google.com/all to set up a context."; }
my $engine = WWW::Google::CustomSearch->new(api_key => $api_key, cx => $cx, quotaUser => "$nick!$user\@$host");
@ -54,13 +53,9 @@ sub googlesearch {
my $result1 = $engine->search("\"$a\" -\"$b\"");
my $result2 = $engine->search("\"$b\" -\"$a\"");
if (not defined $result1 or not defined $result1->items or not @{$result1->items}) {
return "$nick: No results for $a";
}
if (not defined $result1 or not defined $result1->items or not @{$result1->items}) { return "$nick: No results for $a"; }
if (not defined $result2 or not defined $result2->items or not @{$result2->items}) {
return "$nick: No results for $b";
}
if (not defined $result2 or not defined $result2->items or not @{$result2->items}) { return "$nick: No results for $b"; }
my $title1 = $result1->items->[0]->title;
my $title2 = $result2->items->[0]->title;
@ -68,14 +63,20 @@ sub googlesearch {
utf8::decode $title1;
utf8::decode $title2;
return "$nick: $a: (" . $result1->formattedTotalResults . ") " . decode_entities($title1) . " <" . $result1->items->[0]->link . "> VS $b: (" . $result2->formattedTotalResults . ") " . decode_entities($title2) . " <" . $result2->items->[0]->link . ">";
return
"$nick: $a: ("
. $result1->formattedTotalResults . ") "
. decode_entities($title1) . " <"
. $result1->items->[0]->link
. "> VS $b: ("
. $result2->formattedTotalResults . ") "
. decode_entities($title2) . " <"
. $result2->items->[0]->link . ">";
}
my $result = $engine->search($arguments);
if (not defined $result or not defined $result->items or not @{$result->items}) {
return "$nick: No results found";
}
if (not defined $result or not defined $result->items or not @{$result->items}) { return "$nick: No results found"; }
my $output = "$nick: (" . $result->formattedTotalResults . " results) ";

2
Plugins/MagicCommand.pm
View File

@ -26,9 +26,9 @@ sub unload {
sub magic {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
# do something magical!
return "Did something magical.";
}
1;

108
Plugins/Quotegrabs.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::Quotegrabs;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -19,6 +20,7 @@ use Time::HiRes qw(gettimeofday);
use Getopt::Long qw(GetOptionsFromArray);
use Plugins::Quotegrabs::Quotegrabs_SQLite; # use SQLite backend for quotegrabs database
#use Plugins::Quotegrabs::Quotegrabs_Hashtable; # use Perl hashtable backend for quotegrabs database
use PBot::Utils::ValidateString;
@ -29,6 +31,7 @@ sub initialize {
$self->{filename} = $conf{quotegrabs_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.sqlite3';
$self->{database} = Plugins::Quotegrabs::Quotegrabs_SQLite->new(pbot => $self->{pbot}, filename => $self->{filename});
#$self->{database} = Plugins::Quotegrabs::Quotegrabs_Hashtable->new(pbot => $self->{pbot}, filename => $self->{filename});
$self->{database}->begin();
@ -99,11 +102,8 @@ sub export_quotegrabs {
$last_channel = $quotegrab->{channel};
$i++;
if ($i % 2) {
print FILE "<tr bgcolor=\"#dddddd\">\n";
} else {
print FILE "<tr>\n";
}
if ($i % 2) { print FILE "<tr bgcolor=\"#dddddd\">\n"; }
else { print FILE "<tr>\n"; }
print FILE "<td>" . ($quotegrab->{id}) . "</td>";
@ -114,16 +114,12 @@ sub export_quotegrabs {
my $nick;
$text = $quotegrab->{text};
if ($text =~ s/^\/me\s+//) {
$nick = "* $nicks[0]";
} else {
$nick = "<$nicks[0]>";
}
if ($text =~ s/^\/me\s+//) { $nick = "* $nicks[0]"; }
else { $nick = "<$nicks[0]>"; }
$text = "<td><b>" . encode_entities($nick) . "</b> " . encode_entities($text) . "</td>\n";
print FILE $text;
print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %a %H:%M:%S", localtime $quotegrab->{timestamp}) . "</td>\n";
print FILE "<td>" . encode_entities($quotegrab->{grabbed_by}) . "</td>\n";
print FILE "</tr>\n";
@ -154,7 +150,8 @@ sub grab_quotegrab {
}
if (not defined $arguments or not length $arguments) {
return "Usage: grab <nick> [history [channel]] [+ <nick> [history [channel]] ...] -- where [history] is an optional regex argument; e.g., to grab a message containing 'pizza', use `grab nick pizza`; you can chain grabs with + to grab multiple messages";
return
"Usage: grab <nick> [history [channel]] [+ <nick> [history [channel]] ...] -- where [history] is an optional regex argument; e.g., to grab a message containing 'pizza', use `grab nick pizza`; you can chain grabs with + to grab multiple messages";
}
$arguments = lc $arguments;
@ -175,9 +172,7 @@ sub grab_quotegrab {
my ($account, $found_nick) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($grab_nick);
if (not defined $account) {
return "I don't know anybody named $grab_nick";
}
if (not defined $account) { return "I don't know anybody named $grab_nick"; }
$found_nick =~ s/!.*$//;
@ -186,42 +181,33 @@ sub grab_quotegrab {
my $message;
if ($grab_history =~ /^\d+$/) {
# integral history
my $max_messages = $self->{pbot}->{messagehistory}->{database}->get_max_messages($account, $channel);
if ($grab_history < 1 || $grab_history > $max_messages) {
return "Please choose a history between 1 and $max_messages";
}
if ($grab_history < 1 || $grab_history > $max_messages) { return "Please choose a history between 1 and $max_messages"; }
$grab_history--;
$message = $self->{pbot}->{messagehistory}->{database}->recall_message_by_count($account, $channel, $grab_history, 'grab');
} else {
# regex history
$message = $self->{pbot}->{messagehistory}->{database}->recall_message_by_text($account, $channel, $grab_history, 'grab');
if (not defined $message) {
return "No such message for nick $grab_nick in channel $channel containing text '$grab_history'";
}
if (not defined $message) { return "No such message for nick $grab_nick in channel $channel containing text '$grab_history'"; }
}
$self->{pbot}->{logger}->log("$nick ($from) grabbed <$grab_nick/$channel> $message->{msg}\n");
if (not defined $grab_nicks) {
$grab_nicks = $grab_nick;
} else {
$grab_nicks .= "+$grab_nick";
}
if (not defined $grab_nicks) { $grab_nicks = $grab_nick; }
else { $grab_nicks .= "+$grab_nick"; }
my $text = $message->{msg};
if (not defined $grab_text) {
$grab_text = $text;
} else {
if ($text =~ s/^\/me\s+//) {
$grab_text .= " * $grab_nick $text";
} else {
$grab_text .= " <$grab_nick> $text";
}
if (not defined $grab_text) { $grab_text = $text; }
else {
if ($text =~ s/^\/me\s+//) { $grab_text .= " * $grab_nick $text"; }
else { $grab_text .= " <$grab_nick> $text"; }
}
}
@ -235,18 +221,15 @@ sub grab_quotegrab {
$quotegrab->{id} = $self->{database}->add_quotegrab($quotegrab);
if (not defined $quotegrab->{id}) {
return "Failed to grab quote.";
}
if (not defined $quotegrab->{id}) { return "Failed to grab quote."; }
$self->export_quotegrabs();
my $text = $quotegrab->{text};
($grab_nick) = split /\+/, $grab_nicks, 2;
if ($text =~ s/^(NICKCHANGE)\b/changed nick to/ or
$text =~ s/^(KICKED|QUIT)\b/lc "$1"/e or
$text =~ s/^(JOIN|PART)\b/lc "$1ed"/e) {
if ($text =~ s/^(NICKCHANGE)\b/changed nick to/ or $text =~ s/^(KICKED|QUIT)\b/lc "$1"/e or $text =~ s/^(JOIN|PART)\b/lc "$1ed"/e) {
# fix ugly "[nick] quit Quit: Leaving." messages
$text =~ s/^(quit) (.*)/$1 ($2)/;
return "Quote grabbed: $quotegrab->{id}: $grab_nick $text";
@ -262,9 +245,7 @@ sub delete_quotegrab {
my $quotegrab = $self->{database}->get_quotegrab($arguments);
if (not defined $quotegrab) {
return "/msg $nick No quotegrab matching id $arguments found.";
}
if (not defined $quotegrab) { return "/msg $nick No quotegrab matching id $arguments found."; }
if (not $self->{pbot}->{users}->loggedin_admin($from, "$nick!$user\@$host") and $quotegrab->{grabbed_by} ne "$nick!$user\@$host") {
return "You are not the grabber of this quote.";
@ -277,11 +258,8 @@ sub delete_quotegrab {
my ($first_nick) = split /\+/, $quotegrab->{nick}, 2;
if ($text =~ s/^\/me\s+//) {
return "Deleted $arguments: * $first_nick $text";
} else {
return "Deleted $arguments: <$first_nick> $text";
}
if ($text =~ s/^\/me\s+//) { return "Deleted $arguments: * $first_nick $text"; }
else { return "Deleted $arguments: <$first_nick> $text"; }
}
sub show_quotegrab {
@ -289,9 +267,7 @@ sub show_quotegrab {
my $quotegrab = $self->{database}->get_quotegrab($arguments);
if (not defined $quotegrab) {
return "/msg $nick No quotegrab matching id $arguments found.";
}
if (not defined $quotegrab) { return "/msg $nick No quotegrab matching id $arguments found."; }
my $timestamp = $quotegrab->{timestamp};
my $ago = ago(gettimeofday - $timestamp);
@ -325,9 +301,11 @@ sub show_random_quotegrab {
};
my @opt_args = $self->{pbot}->{interpreter}->split_line($arguments, preserve_escapes => 1, strip_quotes => 1);
GetOptionsFromArray(\@opt_args,
GetOptionsFromArray(
\@opt_args,
'channel|c=s' => \$channel_search,
'text|t=s' => \$text_search);
'text|t=s' => \$text_search
);
return "$getopt_error -- $usage" if defined $getopt_error;
@ -341,15 +319,13 @@ sub show_random_quotegrab {
$nick_search = $tmp;
}
if (not defined $channel_search) {
$channel_search = $from;
}
if (not defined $channel_search) { $channel_search = $from; }
}
if (defined $channel_search and $channel_search !~ /^#/) {
if ($channel_search eq $nick) {
$channel_search = undef;
} elsif ($channel_search =~ m/^\./) {
if ($channel_search eq $nick) { $channel_search = undef; }
elsif ($channel_search =~ m/^\./) {
# do nothing
} else {
return "$channel_search is not a valid channel.";
@ -361,19 +337,13 @@ sub show_random_quotegrab {
if (not defined $quotegrab) {
my $result = "No quotes grabbed ";
if (defined $nick_search) {
$result .= "for nick $nick_search ";
}
if (defined $nick_search) { $result .= "for nick $nick_search "; }
if (defined $channel_search) {
$result .= "in channel $channel_search ";
}
if (defined $channel_search) { $result .= "in channel $channel_search "; }
if (defined $text_search) {
$result .= "matching text '$text_search' ";
}
if (defined $text_search) { $result .= "matching text '$text_search' "; }
return $result . "yet ($usage).";;
return $result . "yet ($usage).";
}
my $text = $quotegrab->{text};

32
Plugins/Quotegrabs/Quotegrabs_Hashtable.pm
View File

@ -22,9 +22,7 @@ use Getopt::Long qw(GetOptionsFromString);
use POSIX qw(strftime);
sub new {
if (ref($_[1]) eq 'HASH') {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference");
}
if (ref($_[1]) eq 'HASH') { Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference"); }
my ($class, %conf) = @_;
@ -46,14 +44,14 @@ sub begin {
$self->load_quotegrabs;
}
sub end {
}
sub end { }
sub load_quotegrabs {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
return if not defined $filename;
$self->{pbot}->{logger}->log("Loading quotegrabs from $filename ...\n");
@ -67,8 +65,7 @@ sub load_quotegrabs {
chomp $line;
$i++;
my ($nick, $channel, $timestamp, $grabbed_by, $text) = split(/\s+/, $line, 5);
if (not defined $nick || not defined $channel || not defined $timestamp
|| not defined $grabbed_by || not defined $text) {
if (not defined $nick || not defined $channel || not defined $timestamp || not defined $grabbed_by || not defined $text) {
die "Syntax error around line $i of $filename\n";
}
@ -89,7 +86,8 @@ sub save_quotegrabs {
my $self = shift;
my $filename;
if (@_) { $filename = shift; } else { $filename = $self->{filename}; }
if (@_) { $filename = shift; }
else { $filename = $self->{filename}; }
return if not defined $filename;
open(FILE, "> $filename") or die "Couldn't open $filename: $!\n";
@ -114,15 +112,11 @@ sub add_quotegrab {
sub delete_quotegrab {
my ($self, $id) = @_;
if ($id < 1 || $id > $#{ $self->{quotegrabs} } + 1) {
return undef;
}
if ($id < 1 || $id > $#{$self->{quotegrabs}} + 1) { return undef; }
splice @{$self->{quotegrabs}}, $id - 1, 1;
for(my $i = $id - 1; $i <= $#{ $self->{quotegrabs} }; $i++ ) {
$self->{quotegrabs}[$i]->{id}--;
}
for (my $i = $id - 1; $i <= $#{$self->{quotegrabs}}; $i++) { $self->{quotegrabs}[$i]->{id}--; }
$self->save_quotegrabs();
}
@ -130,9 +124,7 @@ sub delete_quotegrab {
sub get_quotegrab {
my ($self, $id) = @_;
if ($id < 1 || $id > $#{ $self->{quotegrabs} } + 1) {
return undef;
}
if ($id < 1 || $id > $#{$self->{quotegrabs}} + 1) { return undef; }
return $self->{quotegrabs}[$id - 1];
}
@ -161,9 +153,7 @@ sub get_random_quotegrab {
return undef;
}
if ($#quotes < 0) {
return undef;
}
if ($#quotes < 0) { return undef; }
return $quotes[int rand($#quotes + 1)];
}

4
Plugins/Quotegrabs/Quotegrabs_SQLite.pm
View File

@ -18,9 +18,7 @@ use DBI;
use Carp qw(shortmess);
sub new {
if (ref($_[1]) eq 'HASH') {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference");
}
if (ref($_[1]) eq 'HASH') { Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference"); }
my ($class, %conf) = @_;

10
Plugins/RelayUnreg.pm
View File

@ -98,11 +98,15 @@ sub check_queue {
my ($time, $channel, $nick, $user, $host, $msg) = @{$self->{queue}->[0]};
if ($now >= $time) {
# if nick is still present in channel, send the message
if ($self->{pbot}->{nicklist}->is_present($channel, $nick)) {
# ensure they're not banned (+z allows us to see +q/+b messages as normal ones)
my $banned = $self->{pbot}->{bantracker}->is_banned($nick, $user, $host, $channel);
$self->{pbot}->{logger}->log("[RelayUnreg] $nick!$user\@$host $banned->{mode} as $banned->{banmask} in $banned->{channel} by $banned->{owner}, not relaying unregistered message\n") if $banned;
$self->{pbot}->{logger}
->log("[RelayUnreg] $nick!$user\@$host $banned->{mode} as $banned->{banmask} in $banned->{channel} by $banned->{owner}, not relaying unregistered message\n")
if $banned;
$self->{pbot}->{conn}->privmsg($channel, "(unreg) <$nick> $msg") unless $banned;
}
shift @{$self->{queue}};
@ -113,9 +117,7 @@ sub check_queue {
if (keys %{$self->{notified}}) {
my $timeout = gettimeofday - 60 * 15;
foreach my $nick (keys %{$self->{notified}}) {
if ($self->{notified}->{$nick} <= $timeout) {
delete $self->{notified}->{$nick};
}
if ($self->{notified}->{$nick} <= $timeout) { delete $self->{notified}->{$nick}; }
}
}
}

91
Plugins/RemindMe.pm
View File

@ -58,7 +58,8 @@ SQL
sub dbi_begin {
my ($self) = @_;
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1 }) or die $DBI::errstr;
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
or die $DBI::errstr;
};
if ($@) {
@ -95,7 +96,6 @@ sub add_reminder {
sub update_reminder {
my ($self, $id, $data) = @_;
eval {
my $sql = 'UPDATE Reminders SET ';
@ -110,9 +110,7 @@ sub update_reminder {
my $sth = $self->{dbh}->prepare($sql);
my $param = 1;
foreach my $key (keys %$data) {
$sth->bind_param($param++, $data->{$key});
}
foreach my $key (keys %$data) { $sth->bind_param($param++, $data->{$key}); }
$sth->bind_param($param++, $id);
$sth->execute();
@ -172,9 +170,7 @@ sub delete_reminder {
sub remindme {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
if (not $self->{dbh}) {
return "Internal error.";
}
if (not $self->{dbh}) { return "Internal error."; }
my $usage = "Usage: remindme [-c channel] [-r count] message -t time | remindme -l [nick] | remindme -d id";
@ -191,13 +187,15 @@ sub remindme {
Getopt::Long::Configure("bundling");
$arguments =~ s/(?<!\\)'/\\'/g;
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
'r:i' => \$repeat,
't:s' => \$alarm,
'c:s' => \$target,
'm:s' => \$text,
'l:s' => \$list_reminders,
'd:i' => \$delete_id);
'd:i' => \$delete_id
);
return "$getopt_error -- $usage" if defined $getopt_error;
@ -208,9 +206,7 @@ sub remindme {
my $hostmask;
($account, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($nick_override);
if (not $account) {
return "I don't know anybody named $nick_override.";
}
if (not $account) { return "I don't know anybody named $nick_override."; }
($nick_override) = $hostmask =~ m/^([^!]+)!/;
} else {
@ -232,11 +228,8 @@ sub remindme {
}
if (not $count) {
if ($nick_override) {
return "$nick_override has no reminders.";
} else {
return "You have no reminders.";
}
if ($nick_override) { return "$nick_override has no reminders."; }
else { return "You have no reminders."; }
}
$reminders = $count == 1 ? 'reminder' : 'reminders';
@ -248,34 +241,22 @@ sub remindme {
# admins can delete any reminders (perhaps check admin levels against owner level?)
if ($admininfo) {
if (not $self->get_reminder($delete_id)) {
return "Reminder $delete_id does not exist.";
}
if (not $self->get_reminder($delete_id)) { return "Reminder $delete_id does not exist."; }
if ($self->delete_reminder($delete_id)) {
return "Reminder $delete_id deleted.";
} else {
return "Could not delete reminder $delete_id.";
}
if ($self->delete_reminder($delete_id)) { return "Reminder $delete_id deleted."; }
else { return "Could not delete reminder $delete_id."; }
}
my $account = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
$account = $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($account);
my $reminder = $self->get_reminder($delete_id);
if (not $reminder) {
return "Reminder $delete_id does not exist.";
}
if (not $reminder) { return "Reminder $delete_id does not exist."; }
if ($reminder->{account} != $account) {
return "Reminder $delete_id does not belong to you.";
}
if ($reminder->{account} != $account) { return "Reminder $delete_id does not belong to you."; }
if ($self->delete_reminder($delete_id)) {
return "Reminder $delete_id deleted.";
} else {
return "Could not delete reminder $delete_id.";
}
if ($self->delete_reminder($delete_id)) { return "Reminder $delete_id deleted."; }
else { return "Could not delete reminder $delete_id."; }
}
$text = join ' ', @$args if not defined $text;
@ -286,13 +267,9 @@ sub remindme {
my $admininfo = $self->{pbot}->{users}->loggedin_admin($target ? $target : $from, "$nick!$user\@$host");
if ($target) {
if (not defined $admininfo) {
return "Only admins can create channel reminders.";
}
if (not defined $admininfo) { return "Only admins can create channel reminders."; }
if (not $self->{pbot}->{channels}->is_active($target)) {
return "I'm not active in channel $target.";
}
if (not $self->{pbot}->{channels}->is_active($target)) { return "I'm not active in channel $target."; }
}
print "alarm: $alarm\n";
@ -303,21 +280,13 @@ sub remindme {
return $error if $error;
# I don't know how I feel about enforcing arbitrary time restrictions
if ($length > 31536000 * 10) {
return "Come on now, I'll be dead by then.";
}
if ($length > 31536000 * 10) { return "Come on now, I'll be dead by then."; }
if (not defined $admininfo and $length < 60) {
return "Time must be a minimum of 60 seconds.";
}
if (not defined $admininfo and $length < 60) { return "Time must be a minimum of 60 seconds."; }
if (not defined $admininfo and $repeat > 10) {
return "You may only set up to 10 repeats.";
}
if (not defined $admininfo and $repeat > 10) { return "You may only set up to 10 repeats."; }
if ($repeat < 0) {
return "Repeats must be 0 or greater.";
}
if ($repeat < 0) { return "Repeats must be 0 or greater."; }
$alarm = gettimeofday + $length;
@ -326,16 +295,11 @@ sub remindme {
if (not defined $admininfo) {
my $reminders = $self->get_reminders($account);
if (@$reminders >= 3) {
return "You may only set 3 reminders at a time. Use `remindme -d id` to remove a reminder.";
}
if (@$reminders >= 3) { return "You may only set 3 reminders at a time. Use `remindme -d id` to remove a reminder."; }
}
if ($self->add_reminder($account, $target, $text, $alarm, $length, $repeat, "$nick!$user\@$host")) {
return "Reminder added.";
} else {
return "Failed to add reminder.";
}
if ($self->add_reminder($account, $target, $text, $alarm, $length, $repeat, "$nick!$user\@$host")) { return "Reminder added."; }
else { return "Failed to add reminder."; }
}
sub check_reminders {
@ -355,6 +319,7 @@ sub check_reminders {
}
foreach my $reminder (@$reminders) {
# ensures we get the current nick of the person
my $hostmask = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($reminder->{account});
my ($nick) = $hostmask =~ /^([^!]+)!/;

56
Plugins/RestrictedMod.pm
View File

@ -19,7 +19,10 @@ use Storable qw/dclone/;
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->register(sub { $self->modcmd(@_) }, 'mod', 0);
$self->{pbot}->{commands}->set_meta('mod', 'help', 'Provides restricted moderation abilities to voiced users. They can kick/ban/etc only users that are not admins, whitelisted, voiced or opped.');
$self->{pbot}->{commands}->set_meta(
'mod', 'help',
'Provides restricted moderation abilities to voiced users. They can kick/ban/etc only users that are not admins, whitelisted, voiced or opped.'
);
$self->{pbot}->{capabilities}->add('chanmod', 'can-mod', 1);
$self->{pbot}->{capabilities}->add('chanmod', 'can-voice', 1);
@ -47,11 +50,8 @@ sub help {
my ($self, $stuff) = @_;
my $command = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // 'help';
if (exists $self->{commands}->{$command}) {
return $self->{commands}->{$command}->{help};
} else {
return "No such mod command '$command'. I can't help you with that.";
}
if (exists $self->{commands}->{$command}) { return $self->{commands}->{$command}->{help}; }
else { return "No such mod command '$command'. I can't help you with that."; }
}
sub list {
@ -66,13 +66,10 @@ sub generic_command {
if ($channel !~ m/^#/) {
$channel = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist});
if (not defined $channel or $channel !~ /^#/) {
return "Must specify channel from private message. Usage: mod $command <channel> <nick>";
}
if (not defined $channel or $channel !~ /^#/) { return "Must specify channel from private message. Usage: mod $command <channel> <nick>"; }
}
return "I do not have OPs for this channel. I cannot do any moderation here."
if not $self->{pbot}->{chanops}->can_gain_ops($channel);
return "I do not have OPs for this channel. I cannot do any moderation here." if not $self->{pbot}->{chanops}->can_gain_ops($channel);
return "Voiced moderation is not enabled for this channel. Use `regset $channel.restrictedmod 1` to enable."
if not $self->{pbot}->{registry}->get_value($channel, 'restrictedmod');
@ -80,8 +77,7 @@ sub generic_command {
my $user = $self->{pbot}->{users}->loggedin($channel, $hostmask) // {admin => 0, chanmod => 0};
my $voiced = $self->{pbot}->{nicklist}->get_meta($channel, $stuff->{nick}, '+v');
if (not $voiced and not $self->{pbot}->{capabilities}->userhas($user, 'admin')
and not $self->{pbot}->{capabilities}->userhas($user, 'chanmod')) {
if (not $voiced and not $self->{pbot}->{capabilities}->userhas($user, 'admin') and not $self->{pbot}->{capabilities}->userhas($user, 'chanmod')) {
return "You must be voiced (usermode +v) or have the admin or chanmod capability to use this command.";
}
@ -107,29 +103,32 @@ sub generic_command {
}
my $target_nicklist;
if (not $self->{pbot}->{nicklist}->is_present($channel, $target)) {
return "$stuff->{nick}: I do not see anybody named $target in this channel.";
} else {
$target_nicklist = $self->{pbot}->{nicklist}->{nicklist}->{lc $channel}->{lc $target};
}
if (not $self->{pbot}->{nicklist}->is_present($channel, $target)) { return "$stuff->{nick}: I do not see anybody named $target in this channel."; }
else { $target_nicklist = $self->{pbot}->{nicklist}->{nicklist}->{lc $channel}->{lc $target}; }
my $target_user = $self->{pbot}->{users}->loggedin($channel, $target_nicklist->{hostmask});
if ( (defined $target_user and $target_user->{autoop} or $target_user->{autovoice})
or $target_nicklist->{'+v'} or $target_nicklist->{'+o'}
or $self->{pbot}->{capabilities}->userhas($target_user, 'is-whitelisted')) {
return "I don't think so."
or $target_nicklist->{'+v'}
or $target_nicklist->{'+o'}
or $self->{pbot}->{capabilities}->userhas($target_user, 'is-whitelisted'))
{
return "I don't think so.";
}
if ($command eq 'kick') {
$self->{pbot}->{chanops}->add_op_command($channel, "kick $channel $target Have a nice day!");
$self->{pbot}->{chanops}->gain_ops($channel);
} elsif ($command eq 'ban') {
$self->{pbot}->{chanops}->ban_user_timed("$stuff->{nick}!$stuff->{user}\@$stuff->{host}",
"doing something naughty (moderator ban)", $target, $channel, 3600 * 24, 1);
$self->{pbot}->{chanops}->ban_user_timed(
"$stuff->{nick}!$stuff->{user}\@$stuff->{host}",
"doing something naughty (moderator ban)", $target, $channel, 3600 * 24, 1
);
} elsif ($command eq 'mute') {
$self->{pbot}->{chanops}->mute_user_timed("$stuff->{nick}!$stuff->{user}\@$stuff->{host}",
"doing something naughty (moderator mute)", $target, $channel, 3600 * 24, 1);
$self->{pbot}->{chanops}->mute_user_timed(
"$stuff->{nick}!$stuff->{user}\@$stuff->{host}",
"doing something naughty (moderator mute)", $target, $channel, 3600 * 24, 1
);
}
return "";
}
@ -176,11 +175,8 @@ sub modcmd {
return $self->{commands}->{$command}->{subref}->($stuff);
} else {
my $commands = join ', ', sort keys %{$self->{commands}};
if ($from !~ m/^#/) {
return "Usage: mod <channel> <command> [arguments]; commands are: $commands; see `mod help <command>` for more information.";
} else {
return "Usage: mod <command> [arguments]; commands are: $commands; see `mod help <command>` for more information.";
}
if ($from !~ m/^#/) { return "Usage: mod <channel> <command> [arguments]; commands are: $commands; see `mod help <command>` for more information."; }
else { return "Usage: mod <command> [arguments]; commands are: $commands; see `mod help <command>` for more information."; }
}
}

623
Plugins/Spinach.pm
View File

File diff suppressed because it is too large Load Diff

180
Plugins/Spinach/Rank.pm
View File

@ -35,11 +35,8 @@ sub initialize {
sub sort_generic {
my ($self, $key) = @_;
if ($self->{rank_direction} eq '+') {
return $b->{$key} <=> $a->{$key};
} else {
return $a->{$key} <=> $b->{$key};
}
if ($self->{rank_direction} eq '+') { return $b->{$key} <=> $a->{$key}; }
else { return $a->{$key} <=> $b->{$key}; }
}
sub print_generic {
@ -55,14 +52,10 @@ sub print_avg_score {
return "$player->{nick}: $result";
}
sub sort_bad_lies {
my ($self) = @_;
if ($self->{rank_direction} eq '+') {
return $b->{questions_played} - $b->{good_lies} <=> $a->{questions_played} - $a->{good_lies};
} else {
return $a->{questions_played} - $a->{good_lies} <=> $b->{questions_played} - $b->{good_lies};
}
if ($self->{rank_direction} eq '+') { return $b->{questions_played} - $b->{good_lies} <=> $a->{questions_played} - $a->{good_lies}; }
else { return $a->{questions_played} - $a->{good_lies} <=> $b->{questions_played} - $b->{good_lies}; }
}
sub print_bad_lies {
@ -75,11 +68,11 @@ sub print_bad_lies {
sub sort_mentions {
my ($self) = @_;
if ($self->{rank_direction} eq '+') {
return $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third} <=>
$a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third};
return $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third} <=> $a->{games_played} - $a->{times_first} - $a->{times_second} -
$a->{times_third};
} else {
return $a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third} <=>
$b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third};
return $a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third} <=> $b->{games_played} - $b->{times_first} - $b->{times_second} -
$b->{times_third};
}
}
@ -94,7 +87,8 @@ sub sort_expr {
my ($self) = @_;
my $result = eval {
my $result_a = $self->{expr}->val({
my $result_a = $self->{expr}->val(
{
highscore => $a->{high_score},
lowscore => $a->{low_score},
avgscore => $a->{avg_score},
@ -109,9 +103,11 @@ sub sort_expr {
goodguesses => $a->{good_guesses},
badguesses => $a->{bad_guesses},
deceptions => $a->{players_deceived}
});
}
);
my $result_b = $self->{expr}->val({
my $result_b = $self->{expr}->val(
{
highscore => $b->{high_score},
lowscore => $b->{low_score},
avgscore => $b->{avg_score},
@ -126,13 +122,11 @@ sub sort_expr {
goodguesses => $b->{good_guesses},
badguesses => $b->{bad_guesses},
deceptions => $b->{players_deceived}
});
if ($self->{rank_direction} eq '+') {
return $result_b <=> $result_a;
} else {
return $result_a <=> $result_b;
}
);
if ($self->{rank_direction} eq '+') { return $result_b <=> $result_a; }
else { return $result_a <=> $result_b; }
};
if ($@) {
@ -149,7 +143,8 @@ sub print_expr {
return undef if $player->{games_played} == 0;
my $result = eval {
$self->{expr}->val({
$self->{expr}->val(
{
highscore => $player->{high_score},
lowscore => $player->{low_score},
avgscore => $player->{avg_score},
@ -164,7 +159,8 @@ sub print_expr {
goodguesses => $player->{good_guesses},
badguesses => $player->{bad_guesses},
deceptions => $player->{players_deceived}
});
}
);
};
if ($@) {
@ -179,21 +175,81 @@ sub rank {
my ($self, $arguments) = @_;
my %ranks = (
highscore => { sort => sub { $self->sort_generic('high_score', @_) }, print => sub { $self->print_generic('high_score', @_) }, title => 'high score' },
lowscore => { sort => sub { $self->sort_generic('low_score', @_) }, print => sub { $self->print_generic('low_score', @_) }, title => 'low score' },
avgscore => { sort => sub { $self->sort_generic('avg_score', @_) }, print => sub { $self->print_avg_score(@_) }, title => 'average score' },
goodlies => { sort => sub { $self->sort_generic('good_lies', @_) }, print => sub { $self->print_generic('good_lies', @_) }, title => 'good lies' },
badlies => { sort => sub { $self->sort_bad_lies(@_) }, print => sub { $self->print_bad_lies(@_) }, title => 'bad lies' },
first => { sort => sub { $self->sort_generic('times_first', @_) }, print => sub { $self->print_generic('times_first', @_) }, title => 'first place' },
second => { sort => sub { $self->sort_generic('times_second', @_) }, print => sub { $self->print_generic('times_second', @_) }, title => 'second place' },
third => { sort => sub { $self->sort_generic('times_third', @_) }, print => sub { $self->print_generic('times_third', @_) }, title => 'third place' },
mentions => { sort => sub { $self->sort_mentions(@_) }, print => sub { $self->print_mentions(@_) }, title => 'mentions' },
games => { sort => sub { $self->sort_generic('games_played', @_) }, print => sub { $self->print_generic('games_played', @_) }, title => 'games played' },
questions => { sort => sub { $self->sort_generic('questions_played', @_) }, print => sub { $self->print_generic('questions_played', @_) }, title => 'questions played' },
goodguesses => { sort => sub { $self->sort_generic('good_guesses', @_) }, print => sub { $self->print_generic('good_guesses', @_) }, title => 'good guesses' },
badguesses => { sort => sub { $self->sort_generic('bad_guesses', @_) }, print => sub { $self->print_generic('bad_guesses', @_) }, title => 'bad guesses' },
deceptions => { sort => sub { $self->sort_generic('players_deceived', @_) }, print => sub { $self->print_generic('players_deceived', @_) }, title => 'players deceived' },
expr => { sort => sub { $self->sort_expr(@_) }, print => sub { $self->print_expr(@_) }, title => 'expr' },
highscore => {
sort => sub { $self->sort_generic('high_score', @_) },
print => sub { $self->print_generic('high_score', @_) },
title => 'high score'
},
lowscore => {
sort => sub { $self->sort_generic('low_score', @_) },
print => sub { $self->print_generic('low_score', @_) },
title => 'low score'
},
avgscore => {
sort => sub { $self->sort_generic('avg_score', @_) },
print => sub { $self->print_avg_score(@_) },
title => 'average score'
},
goodlies => {
sort => sub { $self->sort_generic('good_lies', @_) },
print => sub { $self->print_generic('good_lies', @_) },
title => 'good lies'
},
badlies => {
sort => sub { $self->sort_bad_lies(@_) },
print => sub { $self->print_bad_lies(@_) },
title => 'bad lies'
},
first => {
sort => sub { $self->sort_generic('times_first', @_) },
print => sub { $self->print_generic('times_first', @_) },
title => 'first place'
},
second => {
sort => sub { $self->sort_generic('times_second', @_) },
print => sub { $self->print_generic('times_second', @_) },
title => 'second place'
},
third => {
sort => sub { $self->sort_generic('times_third', @_) },
print => sub { $self->print_generic('times_third', @_) },
title => 'third place'
},
mentions => {
sort => sub { $self->sort_mentions(@_) },
print => sub { $self->print_mentions(@_) },
title => 'mentions'
},
games => {
sort => sub { $self->sort_generic('games_played', @_) },
print => sub { $self->print_generic('games_played', @_) },
title => 'games played'
},
questions => {
sort => sub { $self->sort_generic('questions_played', @_) },
print => sub { $self->print_generic('questions_played', @_) },
title => 'questions played'
},
goodguesses => {
sort => sub { $self->sort_generic('good_guesses', @_) },
print => sub { $self->print_generic('good_guesses', @_) },
title => 'good guesses'
},
badguesses => {
sort => sub { $self->sort_generic('bad_guesses', @_) },
print => sub { $self->print_generic('bad_guesses', @_) },
title => 'bad guesses'
},
deceptions => {
sort => sub { $self->sort_generic('players_deceived', @_) },
print => sub { $self->print_generic('players_deceived', @_) },
title => 'players deceived'
},
expr => {
sort => sub { $self->sort_expr(@_) },
print => sub { $self->print_expr(@_) },
title => 'expr'
},
);
my @order = qw/highscore lowscore avgscore first second third mentions games questions goodlies badlies deceptions goodguesses badguesses expr/;
@ -208,24 +264,16 @@ sub rank {
$arguments = lc $arguments;
if ($arguments =~ s/^([+-])//) {
$self->{rank_direction} = $1;
} else {
$self->{rank_direction} = '+';
}
if ($arguments =~ s/^([+-])//) { $self->{rank_direction} = $1; }
else { $self->{rank_direction} = '+'; }
my $offset = 1;
if ($arguments =~ s/\s+(\d+)$//) {
$offset = $1;
}
if ($arguments =~ s/\s+(\d+)$//) { $offset = $1; }
my $opt_arg;
if ($arguments =~ /^expr/) {
if ($arguments =~ s/^expr (.+)$/expr/) {
$opt_arg = $1;
} else {
return "Usage: spinach rank expr <expression>";
}
if ($arguments =~ s/^expr (.+)$/expr/) { $opt_arg = $1; }
else { return "Usage: spinach rank expr <expression>"; }
}
if (not exists $ranks{$arguments}) {
@ -263,12 +311,10 @@ sub rank {
last if lc $player->{nick} eq $arguments;
}
if (not $rank) {
push @rankings, "$ranks{key}->{title}: N/A";
} else {
if (not $stats) {
push @rankings, "$ranks{$key}->{title}: N/A";
} else {
if (not $rank) { push @rankings, "$ranks{key}->{title}: N/A"; }
else {
if (not $stats) { push @rankings, "$ranks{$key}->{title}: N/A"; }
else {
$stats =~ s/[^:]+:\s+//;
push @rankings, "$ranks{$key}->{title}: #$rank ($stats)";
}
@ -315,17 +361,11 @@ sub rank {
my $result;
if (not scalar @ranking) {
if ($offset > 1) {
$result = "No rankings available for $self->{channel} at offset #$offset.\n";
if ($offset > 1) { $result = "No rankings available for $self->{channel} at offset #$offset.\n"; }
else { $result = "No rankings available for $self->{channel} yet.\n"; }
} else {
$result = "No rankings available for $self->{channel} yet.\n";
}
} else {
if ($arguments eq 'expr') {
$result = "Rankings for $opt_arg: ";
} else {
$result = "Rankings for $ranks{$arguments}->{title}: ";
}
if ($arguments eq 'expr') { $result = "Rankings for $opt_arg: "; }
else { $result = "Rankings for $ranks{$arguments}->{title}: "; }
$result .= join ', ', @ranking;
}

9
Plugins/Spinach/Stats.pm
View File

@ -117,9 +117,8 @@ sub get_player_data {
my $player_data = eval {
my $sql = 'SELECT ';
if (not @columns) {
$sql .= '*';
} else {
if (not @columns) { $sql .= '*'; }
else {
my $comma = '';
foreach my $column (@columns) {
$sql .= "$comma$column";
@ -153,9 +152,7 @@ sub update_player_data {
my $sth = $self->{dbh}->prepare($sql);
my $param = 1;
foreach my $key (keys %$data) {
$sth->bind_param($param++, $data->{$key});
}
foreach my $key (keys %$data) { $sth->bind_param($param++, $data->{$key}); }
$sth->bind_param($param, $id);
$sth->execute();

8
Plugins/Spinach/update_seent.pl
View File

@ -11,9 +11,7 @@ my $self = {};
sub load_questions {
my ($filename) = @_;
if (not defined $filename) {
$filename = $ENV{HOME} . "/pbot/data/spinach/trivia.json";
}
if (not defined $filename) { $filename = $ENV{HOME} . "/pbot/data/spinach/trivia.json"; }
$self->{loaded_filename} = $filename;
@ -35,9 +33,7 @@ sub load_questions {
$question->{category} = uc $question->{category};
$self->{categories}{$question->{category}}{$question->{id}} = $question;
if (not exists $question->{seen_timestamp}) {
$question->{seen_timestamp} = 0;
}
if (not exists $question->{seen_timestamp}) { $question->{seen_timestamp} = 0; }
$questions++;
}

15
Plugins/TypoSub.pm
View File

@ -51,17 +51,17 @@ sub on_public {
if ($msg =~ m/^\s*s${sep}(.*?)(?<!\\)${sep}(.*?)(?<!\\)${sep}([g]*).*$/ or $msg =~ m/^\s*s${sep}(.*?)(?<!\\)${sep}(.*)$/) {
my ($regex, $replacement, $modifiers) = ($1, $2, $3);
eval {
my $rx = qr/$regex/;
my $messages = $self->{pbot}->{messagehistory}->{database}->get_recent_messages_from_channel($channel, 50, $self->{pbot}->{messagehistory}->{MSG_CHAT}, 'DESC');
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $bot_trigger = $self->{pbot}->{registry}->get_value($channel, 'trigger')
// $self->{pbot}->{registry}->get_value('general', 'trigger');
my $bot_trigger = $self->{pbot}->{registry}->get_value($channel, 'trigger') // $self->{pbot}->{registry}->get_value('general', 'trigger');
my $ignore_commands = $self->{pbot}->{registry}->get_value($channel, 'typosub_ignore_commands')
// $self->{pbot}->{registry}->get_value('typosub', 'ignore_commands') // 1;
my $ignore_commands = $self->{pbot}->{registry}->get_value($channel, 'typosub_ignore_commands') // $self->{pbot}->{registry}->get_value('typosub', 'ignore_commands')
// 1;
foreach my $message (@$messages) {
next if $ignore_commands and $message->{msg} =~ m/^(?:$bot_trigger|$botnick.?)/;
@ -71,11 +71,8 @@ sub on_public {
my $hostmask = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_id($message->{id});
my ($target) = $hostmask =~ m/([^!]+)/;
my $result;
if ($nick eq $target) {
$result = "$nick meant to say: ";
} else {
$result = "$nick thinks $target meant to say: ";
}
if ($nick eq $target) { $result = "$nick meant to say: "; }
else { $result = "$nick thinks $target meant to say: "; }
my $text = $message->{msg};
if ($modifiers =~ m/g/) {
$text =~ s/$rx/$replacement/g;

8
Plugins/UrlTitles.pm
View File

@ -13,7 +13,6 @@ use parent 'Plugins::Plugin';
use warnings; use strict;
use feature 'unicode_strings';
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{registry}->add_default('text', 'general', 'show_url_titles', $conf{show_url_titles} // 1);
@ -41,9 +40,7 @@ sub show_url_titles {
if ($self->{pbot}->{ignorelist}->check_ignore($nick, $user, $host, $channel)) {
my $admin = $self->{pbot}->{users}->loggedin_admin($channel, "$nick!$user\@$host");
if (!defined $admin || $admin->{level} < 10) {
return 0;
}
if (!defined $admin || $admin->{level} < 10) { return 0; }
}
# no titles for unidentified users in +z channels
@ -57,7 +54,8 @@ sub show_url_titles {
if ( $self->{pbot}->{registry}->get_value('general', 'show_url_titles')
and not $self->{pbot}->{registry}->get_value($channel, 'no_url_titles')
and not grep { $channel =~ /$_/i } $self->{pbot}->{registry}->get_value('general', 'show_url_titles_ignore_channels')
and grep { $channel =~ /$_/i } $self->{pbot}->{registry}->get_value('general', 'show_url_titles_channels')) {
and grep { $channel =~ /$_/i } $self->{pbot}->{registry}->get_value('general', 'show_url_titles_channels'))
{
my $count = 0;
while ($msg =~ s/(https?:\/\/[^\s]+)//i && ++$count <= 3) {

24
Plugins/Weather.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::Weather;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -39,7 +40,8 @@ sub weathercmd {
Getopt::Long::Configure("bundling");
my ($user_override, $show_usage);
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
'u=s' => \$user_override,
'h' => \$show_usage
);
@ -52,17 +54,14 @@ sub weathercmd {
my $location_override = $self->{pbot}->{users}->get_user_metadata($from, $hostmask, 'location') // '';
$arguments = $location_override if not length $arguments;
if (defined $user_override and not length $location_override) {
return "No location set or user account does not exist.";
}
if (defined $user_override and not length $location_override) { return "No location set or user account does not exist."; }
if (not length $arguments) {
return $usage;
}
if (not length $arguments) { return $usage; }
return $self->get_weather($arguments);
}
sub get_weather {
my ($self, $location) = @_;
my %cache_opt = (
@ -74,11 +73,9 @@ sub get_weather {
my $response = $ua->get("http://rss.accuweather.com/rss/liveweather_rss.asp?metric=0&locCode=$location");
my $xml;
if ($response->is_success) {
$xml = $response->decoded_content;
} else {
return "Failed to fetch weather data: " . $response->status_line;
}
if ($response->is_success) { $xml = $response->decoded_content; }
else { return "Failed to fetch weather data: " . $response->status_line; }
my $dom = XML::LibXML->load_xml(string => $xml);
@ -89,7 +86,8 @@ sub get_weather {
my $description = $channel->findvalue('./description');
if ($description eq 'Invalid Location') {
return "Location $location not found. Use \"<city>, <country abbrev>\" (e.g. \"paris, fr\") or a US Zip Code or \"<city>, <state abbrev>, US\" (e.g., \"austin, tx, us\").";
return
"Location $location not found. Use \"<city>, <country abbrev>\" (e.g. \"paris, fr\") or a US Zip Code or \"<city>, <state abbrev>, US\" (e.g., \"austin, tx, us\").";
}
$title =~ s/ - AccuW.*$//;

63
Plugins/Wttr.pm
View File

@ -8,6 +8,7 @@
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package Plugins::Wttr;
use parent 'Plugins::Plugin';
use warnings; use strict;
@ -15,6 +16,7 @@ use feature 'unicode_strings';
use utf8;
use feature 'switch';
no if $] >= 5.018, warnings => "experimental::smartmatch";
use PBot::Utils::LWPUserAgentCached;
@ -33,6 +35,7 @@ sub unload {
}
sub wttrcmd {
my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
my @wttr_options = (
@ -65,7 +68,8 @@ sub wttrcmd {
Getopt::Long::Configure("bundling_override", "ignorecase_always");
my %options;
my ($ret, $args) = GetOptionsFromString($arguments,
my ($ret, $args) = GetOptionsFromString(
$arguments,
\%options,
'u=s',
'h',
@ -80,15 +84,11 @@ sub wttrcmd {
my $location_override = $self->{pbot}->{users}->get_user_metadata($from, $hostmask, 'location') // '';
$arguments = $location_override if not length $arguments;
if (defined $options{u} and not length $location_override) {
return "No location set or user account does not exist.";
}
if (defined $options{u} and not length $location_override) { return "No location set or user account does not exist."; }
delete $options{u};
if (not length $arguments) {
return $usage;
}
if (not length $arguments) { return $usage; }
$options{default} = 1 if not keys %options;
@ -103,6 +103,7 @@ sub wttrcmd {
}
sub get_wttr {
my ($self, $location, %options) = @_;
my %cache_opt = (
@ -116,11 +117,9 @@ sub get_wttr {
my $response = $ua->get("http://wttr.in/$location_uri?format=j1&m");
my $json;
if ($response->is_success) {
$json = $response->decoded_content;
} else {
return "Failed to fetch weather data: " . $response->status_line;
}
if ($response->is_success) { $json = $response->decoded_content; }
else { return "Failed to fetch weather data: " . $response->status_line; }
my $wttr = decode_json $json;
@ -157,9 +156,7 @@ sub get_wttr {
}
}
if ($sep eq '') {
$result .= $last_condition;
}
if ($sep eq '') { $result .= $last_condition; }
$result .= "; ";
}
@ -224,17 +221,11 @@ sub get_wttr {
$result .= "Location: $l->{'query'} ($l->{'type'}); ";
}
when ('dewpoint') {
$result .= "Dew point: $h->{'DewPointC'}C/$h->{'DewPointF'}F; ";
}
when ('dewpoint') { $result .= "Dew point: $h->{'DewPointC'}C/$h->{'DewPointF'}F; "; }
when ('feelslike') {
$result .= "Feels like: $h->{'FeelsLikeC'}C/$h->{'FeelsLikeF'}F; ";
}
when ('feelslike') { $result .= "Feels like: $h->{'FeelsLikeC'}C/$h->{'FeelsLikeF'}F; "; }
when ('heatindex') {
$result .= "Heat index: $h->{'HeatIndexC'}C/$h->{'HeatIndexF'}F; ";
}
when ('heatindex') { $result .= "Heat index: $h->{'HeatIndexC'}C/$h->{'HeatIndexF'}F; "; }
when ('moon') {
my $a = $w->{'astronomy'}->[0];
@ -246,29 +237,17 @@ sub get_wttr {
$result .= "Sun: rise: $a->{'sunrise'}, set: $a->{'sunset'}; ";
}
when ('sunhours') {
$result .= "Hours of sun: $w->{'sunHour'}; ";
}
when ('sunhours') { $result .= "Hours of sun: $w->{'sunHour'}; "; }
when ('snowfall') {
$result .= "Total snow: $w->{'totalSnow_cm'}cm; ";
}
when ('snowfall') { $result .= "Total snow: $w->{'totalSnow_cm'}cm; "; }
when ('uvindex') {
$result .= "UV Index: $c->{'uvIndex'}; ";
}
when ('uvindex') { $result .= "UV Index: $c->{'uvIndex'}; "; }
when ('visibility') {
$result .= "Visibility: $c->{'visibility'}km; ";
}
when ('visibility') { $result .= "Visibility: $c->{'visibility'}km; "; }
when ('cloudcover') {
$result .= "Cloud cover: $c->{'cloudcover'}%; ";
}
when ('cloudcover') { $result .= "Cloud cover: $c->{'cloudcover'}%; "; }
default {
$result .= "Option $_ coming soon; " unless lc $_ eq 'u';
}
default { $result .= "Option $_ coming soon; " unless lc $_ eq 'u'; }
}
}

2
misc/tidy vendored Normal file
View File

@ -0,0 +1,2 @@
#!/bin/bash
perltidy -utf8 -nanl -boc $* -b -bext=/ && perltidy -conv -boc -utf8 -kis -l=170 -vmll -pt=2 -sbt=2 -bt=2 -nsfs -ce -b -bext=/ -nolq -nolc -iscl -nbbc -kgb $*

34
modules/c11std.pl vendored
View File

@ -16,7 +16,8 @@ my $RESULTS_SPECIFIED = 2;
my $search = join ' ', @ARGV;
if (not length $search) {
print "Usage: c11std [-list] [-n#] [-section <section>] [search text] -- 'section' must be in the form of X.YpZ where X and Y are section/chapter and, optionally, pZ is paragraph. If both 'section' and 'search text' are specified, then the search space will be within the specified section. You may use -n # to skip to the #th match. To list only the section numbers containing 'search text', add -list.\n";
print
"Usage: c11std [-list] [-n#] [-section <section>] [search text] -- 'section' must be in the form of X.YpZ where X and Y are section/chapter and, optionally, pZ is paragraph. If both 'section' and 'search text' are specified, then the search space will be within the specified section. You may use -n # to skip to the #th match. To list only the section numbers containing 'search text', add -list.\n";
exit 0;
}
@ -40,11 +41,8 @@ if ($search =~ s/-section\s*([A-Z0-9\.p]+)//i or $search =~ s/\b([A-Z0-9]+\.[0-9
$section_specified = 1;
}
if ($search =~ s/-n\s*(\d+)//) {
$match = $1;
} else {
$match = 1;
}
if ($search =~ s/-n\s*(\d+)//) { $match = $1; }
else { $match = 1; }
if ($search =~ s/-list//i) {
$list_only = 1;
@ -86,9 +84,7 @@ my $matches = 0;
my $this_section;
my $comma = "";
if ($list_only) {
$result = "Sections containing '$search':\n ";
}
if ($list_only) { $result = "Sections containing '$search':\n "; }
my $qsearch = quotemeta $search;
$qsearch =~ s/\\ / /g;
@ -100,7 +96,6 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
print "----------------------------------\n" if $debug >= 2;
print "Processing section [$this_section]\n" if $debug;
if ($section_specified and $this_section !~ m/^$section/i) {
print "No section match, skipping.\n" if $debug >= 4;
next;
@ -108,9 +103,8 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
my $section_text;
if ($text =~ m/(.*?)^(?=\s{0,4}(?!FOOTNOTE)[0-9A-Z]+\.)/msg) {
$section_text = $1;
} else {
if ($text =~ m/(.*?)^(?=\s{0,4}(?!FOOTNOTE)[0-9A-Z]+\.)/msg) { $section_text = $1; }
else {
print "No section text, end of file marker found.\n" if $debug >= 4;
last;
}
@ -175,11 +169,8 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
last if $found && $paragraph_specified == $USER_SPECIFIED;
if ($paragraph_specified == $USER_SPECIFIED) {
if (length $search) {
print "No such text '$search' in paragraph $paragraph of section $section of n1570.\n";
} else {
print "No such paragraph $paragraph in section $section of n1570.\n";
}
if (length $search) { print "No such text '$search' in paragraph $paragraph of section $section of n1570.\n"; }
else { print "No such paragraph $paragraph in section $section of n1570.\n"; }
exit 0;
}
@ -209,20 +200,21 @@ if (not $found and $comma eq "") {
$result =~ s/$found_section_title// if length $found_section_title;
$result =~ s/^\s+//;
$result =~ s/\s+$//;
=cut
$result =~ s/\s+/ /g;
$result =~ s/[\n\r]/ /g;
=cut
if ($matches > 1 and not $list_only) {
print "Displaying $match of $matches matches: ";
}
if ($matches > 1 and not $list_only) { print "Displaying $match of $matches matches: "; }
if ($comma eq "") {
=cut
print $found_section;
print "p" . $found_paragraph if $paragraph_specified;
=cut
print "http://www.iso-9899.info/n1570.html\#$found_section";
print "p" . $found_paragraph if $paragraph_specified;
print "\n\n";

74
modules/c2english.pl vendored
View File

@ -24,12 +24,11 @@ if (not length $code) {
my $output;
my $force;
if ($code =~ s/^-f\s+//) {
$force = 1;
}
if ($code =~ s/^-f\s+//) { $force = 1; }
my ($has_function, $has_main, $got_nomain);
my $prelude_base = "#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <errno.h>\n#include <ctype.h>\n#include <assert.h>\n#include <stdnoreturn.h>\n#include <stdbool.h>\n#include <stdalign.h>\n#include <time.h>\n#include <stddef.h>\n#include <uchar.h>\n#define _Atomic\n#define _Static_assert(a, b)\n\n";
my $prelude_base =
"#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <errno.h>\n#include <ctype.h>\n#include <assert.h>\n#include <stdnoreturn.h>\n#include <stdbool.h>\n#include <stdalign.h>\n#include <time.h>\n#include <stddef.h>\n#include <uchar.h>\n#define _Atomic\n#define _Static_assert(a, b)\n\n";
my $prelude = $prelude_base;
print "code before: [$code]\n" if $debug;
@ -58,13 +57,9 @@ while ($code =~ m/(.)/gs) {
}
if ($state == NORMAL) {
when ($_ eq '"' and not $escaped) {
$state = DOUBLE_QUOTED;
}
when ($_ eq '"' and not $escaped) { $state = DOUBLE_QUOTED; }
when ($_ eq "'" and not $escaped) {
$state = SINGLE_QUOTED;
}
when ($_ eq "'" and not $escaped) { $state = SINGLE_QUOTED; }
when ($_ eq 'n' and $escaped == 1) {
$ch = "\n";
@ -73,15 +68,11 @@ while ($code =~ m/(.)/gs) {
}
if ($state == DOUBLE_QUOTED) {
when ($_ eq '"' and not $escaped) {
$state = NORMAL;
}
when ($_ eq '"' and not $escaped) { $state = NORMAL; }
}
if ($state == SINGLE_QUOTED) {
when ($_ eq "'" and not $escaped) {
$state = NORMAL;
}
when ($_ eq "'" and not $escaped) { $state = NORMAL; }
}
}
@ -105,9 +96,8 @@ while ($code =~ m/(.)/msg) {
print "adding newlines, ch = [$ch], parens: $parens, cpp: $cpp, single: $single_quote, double: $double_quote, escaped: $escaped, pos: $pos\n" if $debug >= 10;
if ($ch eq '\\') {
$escaped = not $escaped;
} elsif ($ch eq '#' and not $cpp and not $escaped and not $single_quote and not $double_quote) {
if ($ch eq '\\') { $escaped = not $escaped; }
elsif ($ch eq '#' and not $cpp and not $escaped and not $single_quote and not $double_quote) {
$cpp = 1;
if ($code =~ m/include\s*[<"]([^>"]*)[>"]/msg) {
@ -168,11 +158,8 @@ $white_code =~ s/(?:\"((?:\\\"|(?!\").)*)\")/'"' . ('-' x length $1) . '"'/ge;
$white_code =~ s/(?:\'((?:\\\'|(?!\').)*)\')/"'" . ('-' x length $1) . "'"/ge;
my $precode;
if ($white_code =~ m/#include/) {
$precode = $code;
} else {
$precode = $prelude . $code;
}
if ($white_code =~ m/#include/) { $precode = $code; }
else { $precode = $prelude . $code; }
$code = '';
my $warn_unterminated_define = 0;
@ -182,16 +169,12 @@ my $lang = 'C89';
if ($lang eq 'C89' or $lang eq 'C99' or $lang eq 'C11' or $lang eq 'C++') {
my $prelude = '';
while ($precode =~ s/^\s*(#.*\n{1,2})//g) {
$prelude .= $1;
}
while ($precode =~ s/^\s*(#.*\n{1,2})//g) { $prelude .= $1; }
if ($precode =~ m/^\s*(#.*)/ms) {
my $line = $1;
if ($line !~ m/\n/) {
$warn_unterminated_define = 1;
}
if ($line !~ m/\n/) { $warn_unterminated_define = 1; }
}
print "*** prelude: [$prelude]\n precode: [$precode]\n" if $debug;
@ -260,9 +243,8 @@ if ($lang eq 'C89' or $lang eq 'C99' or $lang eq 'C11' or $lang eq 'C++') {
my @extract = extract_bracketed($potential_body, '{}');
my $body;
if (not defined $extract[0]) {
if ($debug == 0) {
print "error: unmatched brackets\n";
} else {
if ($debug == 0) { print "error: unmatched brackets\n"; }
else {
print "error: unmatched brackets for function '$ident';\n";
print "body: [$potential_body]\n";
}
@ -284,9 +266,8 @@ if ($lang eq 'C89' or $lang eq 'C99' or $lang eq 'C11' or $lang eq 'C++') {
$precode =~ s/^{(.*)}$/$1/s;
if (not $has_main and not $got_nomain) {
$code = "$prelude\n$code" . "int main(void) {\n$precode\n;\n}\n";
} else {
if (not $has_main and not $got_nomain) { $code = "$prelude\n$code" . "int main(void) {\n$precode\n;\n}\n"; }
else {
print "code: [$code]; precode: [$precode]\n" if $debug;
$code = "$prelude\n$precode\n\n$code\n";
}
@ -314,7 +295,8 @@ print $fh $code;
close $fh;
#my ($ret, $result) = execute(10, "gcc -std=c89 -pedantic -Werror -Wno-unused -fsyntax-only -fno-diagnostics-show-option -fno-diagnostics-show-caret code.c");
my ($ret, $result) = execute(10, "gcc -std=c11 -pedantic -Werror -Wno-implicit -Wno-unused -fsyntax-only -fno-diagnostics-show-option -fno-diagnostics-show-caret code.c");
my ($ret, $result) =
execute(10, "gcc -std=c11 -pedantic -Werror -Wno-implicit -Wno-unused -fsyntax-only -fno-diagnostics-show-option -fno-diagnostics-show-caret code.c");
if (not $force and $ret != 0) {
$output = $result;
@ -329,6 +311,7 @@ if (not $force and $ret != 0) {
$output =~ s/(\d+:\d+:\s*)* \(first use in this function\)//g;
$output =~ s/(\d+:\d+:\s*)*error: \(Each undeclared identifier is reported only once.*?\)//msg;
$output =~ s/(\d+:\d+:\s*)*ld: warning: cannot find entry symbol _start; defaulting to [^ ]+//;
#$output =~ s/(\d+:\d+:\s*)*error: (.*?) error/error: $1; error/msg;
$output =~ s/(\d+:\d+:\s*)*\/tmp\/.*\.o://g;
$output =~ s/(\d+:\d+:\s*)*collect2: ld returned \d+ exit status//g;
@ -342,9 +325,11 @@ if (not $force and $ret != 0) {
$output =~ s/`/'/msg;
$output =~ s/\t/ /g;
$output =~ s/(\d+:\d+:\s*)*\s*In function .main.:\s*//g;
$output =~ s/(\d+:\d+:\s*)*warning: unknown conversion type character 'b' in format \[-Wformat\]\s+(\d+:\d+:\s*)*warning: too many arguments for format \[-Wformat-extra-args\]/info: %b is a candide extension/g;
$output =~
s/(\d+:\d+:\s*)*warning: unknown conversion type character 'b' in format \[-Wformat\]\s+(\d+:\d+:\s*)*warning: too many arguments for format \[-Wformat-extra-args\]/info: %b is a candide extension/g;
$output =~ s/(\d+:\d+:\s*)*warning: unknown conversion type character 'b' in format \[-Wformat\]//g;
$output =~ s/\s\(core dumped\)/./;
# $output =~ s/\[\s+/[/g;
$output =~ s/ \[enabled by default\]//g;
$output =~ s/initializer\s+warning: \(near/initializer (near/g;
@ -358,6 +343,7 @@ if (not $force and $ret != 0) {
$output =~ s/\\0"/"/g;
$output =~ s/"\\0/"/g;
$output =~ s/\.\.\.>/>/g;
# $output =~ s/(\\\d{3})+//g;
$output =~ s/<\s*included at \/home\/compiler\/>\s*//g;
$output =~ s/\s*compilation terminated due to -Wfatal-errors\.//g;
@ -419,9 +405,7 @@ if (not $has_function and not $has_main) {
}
$output =~ s/\s+/ /;
if (not $output) {
$output = "Does not compute; I only understand valid C11 code.\n";
}
if (not $output) { $output = "Does not compute; I only understand valid C11 code.\n"; }
print "$output\n";
@ -439,9 +423,7 @@ sub execute {
local $SIG{ALRM} = sub { kill 'TERM', $pid; die "$result [Timed-out]\n"; };
alarm($timeout);
while (my $line = <$fh>) {
$result .= $line;
}
while (my $line = <$fh>) { $result .= $line; }
close $fh;
my $ret = $? >> 8;
@ -451,9 +433,7 @@ sub execute {
alarm 0;
if ($@ =~ /Timed-out/) {
return (-1, $@);
}
if ($@ =~ /Timed-out/) { return (-1, $@); }
return ($ret, $result);
}

31
modules/c99std.pl vendored
View File

@ -16,7 +16,8 @@ my $RESULTS_SPECIFIED = 2;
my $search = join ' ', @ARGV;
if (not length $search) {
print "Usage: c99std [-list] [-n#] [-section <section>] [search text] -- 'section' must be in the form of X.YpZ where X and Y are section/chapter and, optionally, pZ is paragraph. If both 'section' and 'search text' are specified, then the search space will be within the specified section. You may use -n # to skip to the #th match. To list only the section numbers containing 'search text', add -list.\n";
print
"Usage: c99std [-list] [-n#] [-section <section>] [search text] -- 'section' must be in the form of X.YpZ where X and Y are section/chapter and, optionally, pZ is paragraph. If both 'section' and 'search text' are specified, then the search space will be within the specified section. You may use -n # to skip to the #th match. To list only the section numbers containing 'search text', add -list.\n";
exit 0;
}
@ -40,11 +41,8 @@ if ($search =~ s/-section\s*([A-Z0-9\.p]+)//i or $search =~ s/\b([A-Z0-9]+\.[0-9
$section_specified = 1;
}
if ($search =~ s/-n\s*(\d+)//) {
$match = $1;
} else {
$match = 1;
}
if ($search =~ s/-n\s*(\d+)//) { $match = $1; }
else { $match = 1; }
if ($search =~ s/-list//i) {
$list_only = 1;
@ -86,9 +84,7 @@ my $matches = 0;
my $this_section;
my $comma = "";
if ($list_only) {
$result = "Sections containing '$search':\n ";
}
if ($list_only) { $result = "Sections containing '$search':\n "; }
my $qsearch = quotemeta $search;
$qsearch =~ s/\\ / /g;
@ -107,9 +103,8 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
my $section_text;
if ($text =~ m/(.*?)^(?=\s{0,4}(?!FOOTNOTE)[0-9A-Z]+\.)/msg) {
$section_text = $1;
} else {
if ($text =~ m/(.*?)^(?=\s{0,4}(?!FOOTNOTE)[0-9A-Z]+\.)/msg) { $section_text = $1; }
else {
print "No section text, end of file marker found.\n" if $debug >= 4;
last;
}
@ -174,11 +169,8 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
last if $found && $paragraph_specified == $USER_SPECIFIED;
if ($paragraph_specified == $USER_SPECIFIED) {
if (length $search) {
print "No such text '$search' found within paragraph $paragraph of section $section of n1256.\n";
} else {
print "No such paragraph $paragraph in section $section of n1256.\n";
}
if (length $search) { print "No such text '$search' found within paragraph $paragraph of section $section of n1256.\n"; }
else { print "No such paragraph $paragraph in section $section of n1256.\n"; }
exit 0;
}
@ -208,14 +200,13 @@ if (not $found and $comma eq "") {
$result =~ s/$found_section_title// if length $found_section_title;
$result =~ s/^\s+//;
$result =~ s/\s+$//;
=cut
$result =~ s/\s+/ /g;
$result =~ s/[\n\r]/ /g;
=cut
if ($matches > 1 and not $list_only) {
print "Displaying $match of $matches matches: ";
}
if ($matches > 1 and not $list_only) { print "Displaying $match of $matches matches: "; }
if ($comma eq "") {
print "http://www.iso-9899.info/n1256.html\#$found_section";

3
modules/cdecl.pl vendored
View File

@ -23,5 +23,6 @@ chomp $result;
$result =~ s/\n/, /g;
print $result;
print " (Don't use this command. It can only handle C90 declarations -- poorly. Use `english` instead, which can translate any complete C11 code.)" if $result =~ m/^declare/;
print " (Don't use this command. It can only handle C90 declarations -- poorly. Use `english` instead, which can translate any complete C11 code.)"
if $result =~ m/^declare/;
print "\n";

29
modules/codepad.pl vendored
View File

@ -17,7 +17,8 @@ use Text::Balanced qw(extract_codeblock);
my @languages = qw/C C++ D Haskell Lua OCaml PHP Perl Python Ruby Scheme Tcl/;
my %preludes = ( 'C' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n",
my %preludes = (
'C' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n",
'C++' => "#include <iostream>\n#include <cstdio>\n",
);
@ -91,16 +92,14 @@ if ($lang eq "C" or $lang eq "C++") {
$precode =~ s/^\s+//;
$precode =~ s/\s+$//;
if (not $has_main) {
$code = "$prelude\n\n$code\n\nint main(int argc, char **argv) { $precode\n;\n return 0;}\n";
} else {
$code = "$prelude\n\n$precode\n\n$code\n";
}
if (not $has_main) { $code = "$prelude\n\n$code\n\nint main(int argc, char **argv) { $precode\n;\n return 0;}\n"; }
else { $code = "$prelude\n\n$precode\n\n$code\n"; }
} else {
$code = $precode;
}
if ($lang eq "C" or $lang eq "C++") {
# $code = pretty($code);
}
@ -121,11 +120,8 @@ my $url = $response->request->uri;
# remove line numbers
$text =~ s/<a style="" name="output-line-\d+">\d+<\/a>//g;
if ($text =~ /<span class="heading">Output:<\/span>.+?<div class="code">(.*)<\/div>.+?<\/table>/si) {
$output .= "$1";
} else {
$output .= "<pre>No output.</pre>";
}
if ($text =~ /<span class="heading">Output:<\/span>.+?<div class="code">(.*)<\/div>.+?<\/table>/si) { $output .= "$1"; }
else { $output .= "<pre>No output.</pre>"; }
$output = decode_entities($output);
$output = HTML::FormatText->new->format(parse_html($output));
@ -141,11 +137,8 @@ print FILE localtime() . "\n";
print FILE "$nick: [ $url ] $output\n\n";
close FILE;
if ($show_url) {
print "$nick: [ $url ] $output\n";
} else {
print "$nick: $output\n";
}
if ($show_url) { print "$nick: [ $url ] $output\n"; }
else { print "$nick: $output\n"; }
sub pretty {
my $code = join '', @_;
@ -154,9 +147,7 @@ sub pretty {
my $pid = open2(\*IN, \*OUT, 'astyle -Upf');
print OUT "$code\n";
close OUT;
while (my $line = <IN>) {
$result .= $line;
}
while (my $line = <IN>) { $result .= $line; }
close IN;
waitpid($pid, 0);
return $result;

11
modules/compiler_block.pl vendored
View File

@ -18,7 +18,8 @@ use JSON;
my $sock = IO::Socket::INET->new(
PeerAddr => '192.168.0.42',
PeerPort => 9000,
Proto => 'tcp');
Proto => 'tcp'
);
if (not defined $sock) {
print "Fatal error compiling: $!; try again later\n";
@ -31,17 +32,13 @@ my $h = decode_json $json;
$h->{code} =~ s/\s*}\s*$//;
my $lang = $h->{lang} // "c11";
if ($code =~ s/-lang=([^ ]+)//) {
$lang = lc $1;
}
if ($code =~ s/-lang=([^ ]+)//) { $lang = lc $1; }
$h->{lang} = $lang;
$json = encode_json $h;
print $sock "$json\n";
while (my $line = <$sock>) {
print "$line";
}
while (my $line = <$sock>) { print "$line"; }
close $sock;

11
modules/compiler_client.pl vendored
View File

@ -18,7 +18,8 @@ use JSON;
my $sock = IO::Socket::INET->new(
PeerAddr => '127.0.0.1',
PeerPort => 9000,
Proto => 'tcp');
Proto => 'tcp'
);
if (not defined $sock) {
print "Fatal error compiling: $!; try again later\n";
@ -29,17 +30,13 @@ my $json = join ' ', @ARGV;
my $h = decode_json $json;
my $lang = $h->{lang} // "c11";
if ($h->{code} =~ s/-lang=([^ ]+)//) {
$lang = lc $1;
}
if ($h->{code} =~ s/-lang=([^ ]+)//) { $lang = lc $1; }
$h->{lang} = $lang;
$json = encode_json $h;
print $sock "$json\n";
while(my $line = <$sock>) {
print "$line";
}
while (my $line = <$sock>) { print "$line"; }
close $sock;

32
modules/define.pl vendored
View File

@ -10,8 +10,7 @@ use LWP::Simple;
my ($defint, $phrase, $text, $entry, $entries, $i);
if ($#ARGV < 0)
{
if ($#ARGV < 0) {
print "What phrase would you like to define?\n";
die;
}
@ -20,8 +19,7 @@ $phrase = join("%20", @ARGV);
$entry = 1;
if ($phrase =~ m/([0-9]+)%20(.*)/)
{
if ($phrase =~ m/([0-9]+)%20(.*)/) {
$entry = $1;
$phrase = $2;
}
@ -30,19 +28,15 @@ $text = get("http://dictionary.reference.com/browse/$phrase");
$phrase =~ s/\%20/ /g;
if ($text =~ m/no dictionary results/i)
{
if ($text =~ m/no dictionary results/i) {
print "No entry found for '$phrase'. ";
if ($text =~ m/Did you mean <a class.*?>(.*?)<\/a>/g)
{
if ($text =~ m/Did you mean <a class.*?>(.*?)<\/a>/g) {
print "Did you mean '$1'? Alternate suggestions: ";
$i = 90;
$comma = "";
while ($text =~ m/<div id="spellSuggestWrapper"><li .*?><a href=.*?>(.*?)<\/a>/g && $i > 0)
{
while ($text =~ m/<div id="spellSuggestWrapper"><li .*?><a href=.*?>(.*?)<\/a>/g && $i > 0) {
print "$comma$1";
$i--;
$comma = ", ";
@ -66,15 +60,11 @@ if ($text =~ m/no dictionary results/i)
exit 0;
}
if ($text =~ m/- (.*?) dictionary result/g)
{
$entries = $1;
}
if ($text =~ m/- (.*?) dictionary result/g) { $entries = $1; }
$entries = 1 if (not defined $entries);
if ($entry > $entries)
{
if ($entry > $entries) {
print "No entry found for $phrase.\n";
exit 0;
}
@ -89,12 +79,8 @@ my $quote = chr(226) . chr(128) . chr(156);
my $quote2 = chr(226) . chr(128) . chr(157);
my $dash = chr(226) . chr(128) . chr(147);
while ($i <= $entries)
{
if ($text =~ m/<td>(.*?)<\/td>/gs)
{
$defint = $1;
}
while ($i <= $entries) {
if ($text =~ m/<td>(.*?)<\/td>/gs) { $defint = $1; }
# and now for some fugly beautifying regexps...

11
modules/dice_roll.pl vendored
View File

@ -10,17 +10,14 @@ use Games::Dice qw/roll roll_array/;
my ($result, $rolls, $show);
if ($#ARGV <0)
{
if ($#ARGV < 0) {
print "Usage: roll [-show] <dice roll>; e.g.: roll 3d6+1. To see all individual dice rolls, add -show.\n";
die;
}
$rolls = join("", @ARGV);
if ($rolls =~ s/\s*-show\s*//) {
$show = 1;
}
if ($rolls =~ s/\s*-show\s*//) { $show = 1; }
if ($rolls =~ m/^\s*(\d+)d\d+(?:\+?-?\d+)?\s*$/) {
if ($1 > 100) {
@ -35,9 +32,7 @@ if ($rolls =~ m/^\s*(\d+)d\d+(?:\+?-?\d+)?\s*$/) {
if ($show) {
my @results = roll_array $rolls;
$result = 0;
foreach my $n (@results) {
$result += $n;
}
foreach my $n (@results) { $result += $n; }
print "/me rolled $rolls for @results totaling $result.\n";
} else {
$result = roll $rolls;

160
modules/dict.org.pl vendored
View File

@ -4,6 +4,7 @@
eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
if 0; # not running under some shell
=cut
#
# dict - perl DICT client (for accessing network dictionary servers)
#
@ -43,17 +44,14 @@ list_databases() if $config->dbs;
list_strategies() if $config->strats;
=cut
if ($config->database) {
$dict->setDicts($config->database);
} else {
$dict->setDicts('wn');
}
if ($config->database) { $dict->setDicts($config->database); }
else { $dict->setDicts('wn'); }
#-----------------------------------------------------------------------
# Perform define or match, if a word or pattern was given
#-----------------------------------------------------------------------
if (@ARGV > 0)
{
if (@ARGV > 0) {
=cut
if ($config->match)
{
@ -62,12 +60,16 @@ if (@ARGV > 0)
else
{
=cut
define_word(join ' ', @ARGV);
=cut
}
=cut
} else {
print "Usage: dict [-d database] [-n start from definition number] [-t abbreviation of word class type (n]oun, v]erb, adv]erb, adj]ective, etc)] [-search <regex> for definitions matching <regex>] <word>\n";
print
"Usage: dict [-d database] [-n start from definition number] [-t abbreviation of word class type (n]oun, v]erb, adv]erb, adj]ective, etc)] [-search <regex> for definitions matching <regex>] <word>\n";
exit 0;
}
@ -80,24 +82,17 @@ exit 0;
# Look up definition(s) for the specified word.
#
#=======================================================================
sub define_word
{
sub define_word {
my $word = shift;
my $eref;
my $entry;
my ($db, $def);
$eref = $dict->define($word);
if (@$eref == 0)
{
_no_definitions($word);
}
else
{
foreach $entry (@$eref)
{
if (@$eref == 0) { _no_definitions($word); }
else {
foreach $entry (@$eref) {
($db, $def) = @$entry;
my $defs = dict_hash($def);
@ -146,11 +141,8 @@ sub define_word
$types .= "$comma$type";
$comma = ', ';
}
if (length $types) {
print "no `$def_type` definition found; available definitions: $types.\n";
} else {
print "no definition found.\n";
}
if (length $types) { print "no `$def_type` definition found; available definitions: $types.\n"; }
else { print "no definition found.\n"; }
} elsif (not $defined) {
print "no definition found.\n";
}
@ -175,15 +167,9 @@ sub dict_hash {
$line =~ s/\s+$//;
$line =~ s/\s+/ /g;
if ($line =~ m/^([a-z]+) (\d+): (.*)/i) {
($type, $number, $text) = ($1, $2, $3);
}
elsif ($line =~ m/^(\d+): (.*)/i) {
($number, $text) = ($1, $2);
}
else {
$text = $line;
}
if ($line =~ m/^([a-z]+) (\d+): (.*)/i) { ($type, $number, $text) = ($1, $2, $3); }
elsif ($line =~ m/^(\d+): (.*)/i) { ($number, $text) = ($1, $2); }
else { $text = $line; }
$text = " $text" if exists $defs->{$type}{$number};
$defs->{$type}{$number} .= $text;
@ -202,34 +188,25 @@ sub dict_hash {
# it, etc.
#
#=======================================================================
sub _no_definitions
{
sub _no_definitions {
my $word = shift;
my %strategies;
my %words;
my $strategy;
%strategies = $dict->strategies;
if (!exists($strategies{'lev'}) && !exists($strategies{'soundex'}))
{
if (!exists($strategies{'lev'}) && !exists($strategies{'soundex'})) {
print "no definition found for \"$word\"\n";
return;
}
$strategy = exists $strategies{'lev'} ? 'lev' : 'soundex';
foreach my $entry (@{ $dict->match($word, $strategy) })
{
$words{$entry->[1]}++;
}
if (keys %words == 0)
{
foreach my $entry (@{$dict->match($word, $strategy)}) { $words{$entry->[1]}++; }
if (keys %words == 0) {
print "no definition found for \"$word\", ",
"and no similar words found\n";
}
else
{
} else {
print "no definition found for \"$word\" - perhaps you meant: ", join(', ', keys %words), "\n";
}
}
@ -242,28 +219,18 @@ sub _no_definitions
# with the -strategy switch.
#
#=======================================================================
sub match_word
{
sub match_word {
my $word = shift;
my $eref;
my $entry;
my ($db, $match);
unless ($config->strategy)
{
die "you must specify -strategy when using -match\n";
}
unless ($config->strategy) { die "you must specify -strategy when using -match\n"; }
$eref = $dict->match($word, $config->strategy);
if (@$eref == 0)
{
print "no matches for \"$word\"\n";
}
else
{
foreach $entry (@$eref)
{
if (@$eref == 0) { print "no matches for \"$word\"\n"; }
else {
foreach $entry (@$eref) {
($db, $match) = @$entry;
print "$db : $match\n";
}
@ -278,11 +245,9 @@ sub match_word
# DICT server.
#
#=======================================================================
sub list_databases
{
sub list_databases {
my %dbs = $dict->dbs();
tabulate_hash(\%dbs, 'Database', 'Description');
}
@ -294,11 +259,9 @@ sub list_databases
# by the DICT server.
#
#=======================================================================
sub list_strategies
{
sub list_strategies {
my %strats = $dict->strategies();
tabulate_hash(\%strats, 'Strategy', 'Description');
}
@ -314,14 +277,11 @@ sub list_strategies
# credits, etc.
#
#=======================================================================
sub show_db_info
{
sub show_db_info {
my $db = shift;
my %dbs = $dict->dbs();
if (not exists $dbs{$config->info})
{
if (not exists $dbs{$config->info}) {
print " dictionary \"$db\" not known\n";
return;
}
@ -336,8 +296,8 @@ sub show_db_info
# check config file and command-line
#
#=======================================================================
sub initialise
{
sub initialise {
#-------------------------------------------------------------------
# Initialise misc global variables
#-------------------------------------------------------------------
@ -346,12 +306,16 @@ sub initialise
#-------------------------------------------------------------------
# Create AppConfig::Std, define parameters, and parse command-line
#-------------------------------------------------------------------
$config = AppConfig::Std->new({ CASE => 1 })
|| die "failed to create AppConfig::Std: $!\n";
$config = AppConfig::Std->new({CASE => 1}) || die "failed to create AppConfig::Std: $!\n";
$config->define('host', {ARGCOUNT => 1, ALIAS => 'h'});
$config->define('port', { ARGCOUNT => 1, ALIAS => 'p',
DEFAULT => 2628 });
$config->define(
'port',
{
ARGCOUNT => 1, ALIAS => 'p',
DEFAULT => 2628
}
);
$config->define('database', {ARGCOUNT => 1, ALIAS => 'd'});
$config->define('def_number', {ARGCOUNT => 1, ALIAS => 'n', DEFAULT => 1});
$config->define('def_type', {ARGCOUNT => 1, ALIAS => 't', DEFAULT => '*'});
@ -363,10 +327,15 @@ sub initialise
$config->define('strategy', { ARGCOUNT => 1, ALIAS => 's' });
$config->define('strats', { ARGCOUNT => 0, ALIAS => 'S' });
=cut
$config->define('client', { ARGCOUNT => 1, ALIAS => 'c',
DEFAULT => "$PROGRAM $VERSION ".
"[using Net::Dict $Net::Dict::VERSION]",
});
$config->define(
'client',
{
ARGCOUNT => 1, ALIAS => 'c',
DEFAULT => "$PROGRAM $VERSION " . "[using Net::Dict $Net::Dict::VERSION]",
}
);
=cut
$config->define('info', { ARGCOUNT => 1, ALIAS => 'i' });
$config->define('serverinfo', { ARGCOUNT => 0, ALIAS => 'I' });
@ -374,7 +343,8 @@ sub initialise
=cut
if (not $config->args(\@ARGV)) {
print "Usage: dict [-d database] [-n start from definition number] [-t abbreviation of word class type (n]oun, v]erb, adv]erb, adj]ective, etc)] [-search <regex> for definitions matching <regex>] <word>\n";
print
"Usage: dict [-d database] [-n start from definition number] [-t abbreviation of word class type (n]oun, v]erb, adv]erb, adj]ective, etc)] [-search <regex> for definitions matching <regex>] <word>\n";
exit;
}
@ -388,12 +358,12 @@ sub initialise
#-------------------------------------------------------------------
# Create connection to DICT server
#-------------------------------------------------------------------
$dict = Net::Dict->new($config->host,
$dict = Net::Dict->new(
$config->host,
Port => $config->port,
Client => $config->client,
Debug => $config->debug,
)
|| die "failed to create Net::Dict: $!\n";
) || die "failed to create Net::Dict: $!\n";
}
#=======================================================================
@ -404,8 +374,8 @@ sub initialise
# of databases and strategies.
#
#=======================================================================
sub tabulate_hash
{
sub tabulate_hash {
my $hashref = shift;
my $keytitle = shift;
my $value_title = shift;
@ -413,29 +383,21 @@ sub tabulate_hash
my $width = length $keytitle;
my ($key, $value);
#-------------------------------------------------------------------
# Find the length of the longest key, so we can right align
# the column of keys
#-------------------------------------------------------------------
foreach $key (keys %$hashref)
{
$width = length($key) if length($key) > $width;
}
foreach $key (keys %$hashref) { $width = length($key) if length($key) > $width; }
#-------------------------------------------------------------------
# print out keys and values in a basic ascii formatted table view
#-------------------------------------------------------------------
printf(" %${width}s $value_title\n", $keytitle);
print ' ', '-' x $width, ' ', '-' x (length $value_title), "\n";
while (($key, $value) = each %$hashref)
{
printf(" %${width}s : $value\n", $key);
}
while (($key, $value) = each %$hashref) { printf(" %${width}s : $value\n", $key); }
print "\n";
}
__END__
=head1 NAME

39
modules/expand_macros.pl vendored
View File

@ -55,13 +55,9 @@ while ($code =~ m/(.)/gs) {
}
if ($state == NORMAL) {
when ($_ eq '"' and not $escaped) {
$state = DOUBLE_QUOTED;
}
when ($_ eq '"' and not $escaped) { $state = DOUBLE_QUOTED; }
when ($_ eq "'" and not $escaped) {
$state = SINGLE_QUOTED;
}
when ($_ eq "'" and not $escaped) { $state = SINGLE_QUOTED; }
when ($_ eq 'n' and $escaped == 1) {
$ch = "\n";
@ -70,15 +66,11 @@ while ($code =~ m/(.)/gs) {
}
if ($state == DOUBLE_QUOTED) {
when ($_ eq '"' and not $escaped) {
$state = NORMAL;
}
when ($_ eq '"' and not $escaped) { $state = NORMAL; }
}
if ($state == SINGLE_QUOTED) {
when ($_ eq "'" and not $escaped) {
$state = NORMAL;
}
when ($_ eq "'" and not $escaped) { $state = NORMAL; }
}
}
@ -102,9 +94,8 @@ while ($code =~ m/(.)/msg) {
print "adding newlines, ch = [$ch], parens: $parens, cpp: $cpp, single: $single_quote, double: $double_quote, escaped: $escaped, pos: $pos\n" if $debug >= 10;
if ($ch eq '\\') {
$escaped = not $escaped;
} elsif ($ch eq '#' and not $cpp and not $escaped and not $single_quote and not $double_quote) {
if ($ch eq '\\') { $escaped = not $escaped; }
elsif ($ch eq '#' and not $cpp and not $escaped and not $single_quote and not $double_quote) {
$cpp = 1;
if ($code =~ m/include\s*[<"]([^>"]*)[>"]/msg) {
@ -171,9 +162,7 @@ print "--- precode: [$precode]\n" if $debug;
my $has_main = 0;
if ($lang eq 'C89' or $lang eq 'C99' or $lang eq 'C11' or $lang eq 'C++') {
my $prelude = '';
while ($precode =~ s/^\s*(#.*\n{1,2})//g) {
$prelude .= $1;
}
while ($precode =~ s/^\s*(#.*\n{1,2})//g) { $prelude .= $1; }
print "*** prelude: [$prelude]\n precode: [$precode]\n" if $debug;
@ -241,9 +230,8 @@ if ($lang eq 'C89' or $lang eq 'C99' or $lang eq 'C11' or $lang eq 'C++') {
my @extract = extract_bracketed($potential_body, '{}');
my $body;
if (not defined $extract[0]) {
if ($debug == 0) {
print "error: unmatched brackets\n";
} else {
if ($debug == 0) { print "error: unmatched brackets\n"; }
else {
print "error: unmatched brackets for function '$ident';\n";
print "body: [$potential_body]\n";
}
@ -324,9 +312,7 @@ sub execute {
local $SIG{ALRM} = sub { print "Time out\n" if $debug; kill 'TERM', $pid; die "$result [Timed-out]\n"; };
alarm($timeout);
while (my $line = <$fh>) {
$result .= $line;
}
while (my $line = <$fh>) { $result .= $line; }
close $fh;
my $ret = $? >> 8;
@ -337,12 +323,9 @@ sub execute {
print "done eval\n" if $debug;
alarm 0;
if ($@ =~ /Timed-out/) {
return (-1, $@);
}
if ($@ =~ /Timed-out/) { return (-1, $@); }
print "[$ret, $result]\n" if $debug;
return ($ret, $result);
}

3
modules/funnyish_quote.pl vendored
View File

@ -17,8 +17,7 @@ my %post = ( 'number' => '4', 'collection[]' => '20thcent' );
my $response = $ua->post("http://www.quotationspage.com/random.php3", \%post);
if (not $response->is_success)
{
if (not $response->is_success) {
print "Couldn't get quote information.\n";
die;
}

21
modules/gdefine.pl vendored
View File

@ -12,8 +12,7 @@ use LWP::UserAgent;
my ($defint, $phrase, $text, $entry, $entries, $i);
my @defs;
if ($#ARGV < 0)
{
if ($#ARGV < 0) {
print "What phrase would you like to define?\n";
die;
}
@ -22,8 +21,7 @@ $phrase = join("+", @ARGV);
$entry = 1;
if ($phrase =~ m/([0-9]+)\+(.*)/)
{
if ($phrase =~ m/([0-9]+)\+(.*)/) {
$entry = $1;
$phrase = $2;
}
@ -33,13 +31,10 @@ $ua->agent("howdy");
my $response = $ua->get("http://www.google.com/search?q=define:$phrase");
$phrase =~ s/\+/ /g;
if (not $response->is_success) {
exit(1);
}
if (not $response->is_success) { exit(1); }
$text = $response->content;
if ($text =~ m/No definitions were found/i)
{
if ($text =~ m/No definitions were found/i) {
print "No entry found for '$phrase'. ";
print "\n";
exit 1;
@ -49,12 +44,8 @@ print "$phrase: ";
$i = $entry;
while ($i <= $entry + 5)
{
if ($text =~ m/<li>(.*?)<br>/gs)
{
push @defs, $1;
}
while ($i <= $entry + 5) {
if ($text =~ m/<li>(.*?)<br>/gs) { push @defs, $1; }
$i++;
}

1
modules/gen_cfacts.pl vendored
View File

@ -14,6 +14,7 @@ use HTML::Entities;
my $STD = 'n1570.html';
my $text;
{
local $/ = undef;
open my $fh, "<", $STD or die "Could not open $STD: $!";

48
modules/gencstd.pl vendored
View File

@ -19,11 +19,11 @@ sub gen_txt;
sub gen_html;
open FH, "<n1256.txt" or die "Could not open n1256.txt: $!";
#open FH, "<n1570.txt" or die "Could not open n1570.txt: $!";
my @contents = <FH>;
close FH;
my $text = join '', @contents;
$text =~ s/\r//g;
@ -38,6 +38,7 @@ my $footnote = 0;
my $last_footnote = 0;
gen_data;
#gen_txt;
gen_html;
@ -65,9 +66,8 @@ sub gen_data {
my $section_text;
if ($text =~ m/(.*?)^(?=\s{0,4}[0-9A-Z]+\.)/msg) {
$section_text = $1;
} else {
if ($text =~ m/(.*?)^(?=\s{0,4}[0-9A-Z]+\.)/msg) { $section_text = $1; }
else {
print STDERR "No section text, end of file marker found.\n";
last;
}
@ -83,9 +83,8 @@ sub gen_data {
print STDERR "section text: [$section_text]\n" if $debug >= 2;
if (not $section_text =~ m/^(?=\d+\s)/msg) {
$sections{$this_section}{text} = $section_text;
} else {
if (not $section_text =~ m/^(?=\d+\s)/msg) { $sections{$this_section}{text} = $section_text; }
else {
my $last_p = 0;
my $p = 0;
while ($section_text =~ m/^(\d+)\s(.*?)^(?=\d)/msgc or $section_text =~ m/^(\d+)\s(.*)/msg) {
@ -95,9 +94,7 @@ sub gen_data {
print STDERR "paragraph $p: [$t]\n" if $debug >= 3;
if (($last_p - $p) != -1) {
die "Paragraph diff invalid";
}
if (($last_p - $p) != -1) { die "Paragraph diff invalid"; }
while ($t =~ m/^(\s*)(\d+)\)(\s*)(.*?)$/msg) {
my $leading_spaces = $1;
@ -110,6 +107,7 @@ sub gen_data {
print STDERR "footnotes dump: \n" if $debug > 5;
shift @footnotes;
my $dump = Dumper(@footnotes) if $debug > 5;
#print STDERR "$dump\n";
die "Footnote diff invalid";
}
@ -211,15 +209,11 @@ sub bysection {
my $i = 0;
for (; $i < $#k1 + 1; $i++) {
if (not defined $k2[$i]) {
$r[$i] = 1;
} else {
if (not defined $k2[$i]) { $r[$i] = 1; }
else {
print STDERR " cmp k1[$i] ($k1[$i]) vs k2[$i] ($k2[$i])\n" if $debug >= 5;
if ($i == 0) {
$r[$i] = $k1[$i] cmp $k2[$i];
} else {
$r[$i] = $k1[$i] <=> $k2[$i];
}
if ($i == 0) { $r[$i] = $k1[$i] cmp $k2[$i]; }
else { $r[$i] = $k1[$i] <=> $k2[$i]; }
}
print STDERR " r[$i] = $r[$i]\n" if $debug >= 5;
}
@ -261,6 +255,7 @@ sub gen_txt {
for ($footnote = 1; $footnote < $#footnotes; $footnote++) {
my $sub = quotemeta $footnotes[$footnote];
$sub =~ s/(\\ )+/\\s*/g;
#print STDERR "subbing out [$footnote) $sub]\n";
$section_text =~ s/^\s*$footnote\)\s*$sub//ms;
}
@ -273,11 +268,9 @@ sub gen_txt {
while ($line =~ m/(.)/g) {
my $c = $1;
if ($c =~ m/[0-9]/) {
$number .= $c;
} elsif ($c eq ' ') {
$number = "";
} elsif ($c eq '(') {
if ($c =~ m/[0-9]/) { $number .= $c; }
elsif ($c eq ' ') { $number = ""; }
elsif ($c eq '(') {
$paren++;
print STDERR "got $paren (\n" if $debug >= 8;
} elsif ($c eq ')') {
@ -323,6 +316,7 @@ sub gen_html {
for ($footnote = 1; $footnote < $#footnotes; $footnote++) {
my $sub = quotemeta $footnotes[$footnote];
$sub =~ s/(\\ )+/\\s*/g;
#print STDERR "subbing out [$footnote) $sub]\n";
$section_text =~ s/^\s*$footnote\)\s*$sub//ms;
}
@ -337,11 +331,9 @@ sub gen_html {
while ($line =~ m/(.)/g) {
my $c = $1;
if ($c =~ m/[0-9]/) {
$number .= $c;
} elsif ($c eq ' ') {
$number = "";
} elsif ($c eq '(') {
if ($c =~ m/[0-9]/) { $number .= $c; }
elsif ($c eq ' ') { $number = ""; }
elsif ($c eq '(') {
$paren++;
print STDERR "got $paren (\n" if $debug >= 8;
} elsif ($c eq ')') {

18
modules/get_title.pl vendored
View File

@ -11,8 +11,7 @@ use HTML::Entities;
use Text::Levenshtein qw(fastdistance);
use Time::HiRes qw(gettimeofday);
if ($#ARGV <= 0)
{
if ($#ARGV <= 0) {
print "Usage: title nick URL\n";
exit;
}
@ -89,8 +88,8 @@ $ua->max_size(200 * 1024);
my $response = $ua->get("$arguments");
if (not $response->is_success)
{
if (not $response->is_success) {
#print "Couldn't get link.\n";
use Data::Dumper;
print STDERR Dumper $response;
@ -99,10 +98,9 @@ if (not $response->is_success)
my $text = $response->decoded_content;
if ($text =~ m/<title>(.*?)<\/title>/msi)
{
$t = $1;
} else {
if ($text =~ m/<title>(.*?)<\/title>/msi) { $t = $1; }
else {
#print "No title for link.\n";
exit;
}
@ -152,9 +150,7 @@ $file =~ s/[_-]/ /g;
my $distance = fastdistance(lc $file, lc $t);
my $length = (length $file > length $t) ? length $file : length $t;
if ($distance / $length < 0.75) {
exit;
}
if ($distance / $length < 0.75) { exit; }
exit if $t !~ m/\s/; # exit if title is only one word -- this isn't usually interesting
exit if $t =~ m{christel}i;

7
modules/getcfact.pl vendored
View File

@ -33,8 +33,5 @@ while (my $fact = <$fh>) {
}
close $fh;
if (not @facts) {
print "No fact containing text $text found.\n";
} else {
print $facts[int rand(@facts)], "\n";
}
if (not @facts) { print "No fact containing text $text found.\n"; }
else { print $facts[int rand(@facts)], "\n"; }

46
modules/headlines.pl vendored
View File

@ -12,31 +12,40 @@ use LWP::Simple;
# similiar URLS (try Google?) may be useful.
my %news_sites = (
"jbad" => [ "http://jalalabad.us/backend/geeklog.rdf",
"jbad" => [
"http://jalalabad.us/backend/geeklog.rdf",
"Jalalabad.us"
],
"bbc" => [ "http://news.bbc.co.uk/rss/newsonline_uk_edition/world/rss091.xml",
"bbc" => [
"http://news.bbc.co.uk/rss/newsonline_uk_edition/world/rss091.xml",
"news.bbc.co.uk"
],
"cnn" => [ "http://www.cnn.com/cnn.rss",
"cnn" => [
"http://www.cnn.com/cnn.rss",
"CNN News"
],
"chealth" => [ "http://www.cnn.com/health/health.rdf",
"chealth" => [
"http://www.cnn.com/health/health.rdf",
"CNN Health"
],
"ctech" => [ "http://www.cnn.com/technology/tech.rdf",
"ctech" => [
"http://www.cnn.com/technology/tech.rdf",
"CNN Technology"
],
"csports" => [ "http://www.cnn.com/sports/sports.rdf",
"csports" => [
"http://www.cnn.com/sports/sports.rdf",
"CNN Sports"
],
"/." => [ "http://slashdot.org/slashdot.rdf",
"/." => [
"http://slashdot.org/slashdot.rdf",
"Slashdot"
],
"nyttech" => [ "http://xml.newsisfree.com/feeds/62/162.xml",
"nyttech" => [
"http://xml.newsisfree.com/feeds/62/162.xml",
"New York Times Technology"
],
"morons" => [ "http://www.morons.org/morons.rss",
"morons" => [
"http://www.morons.org/morons.rss",
"morons.org"
]
);
@ -46,7 +55,6 @@ my $links = 0;
my $key;
my $value;
if ($args =~ /^links\s+(.*)/i) {
$args = $1;
$links = 1;
@ -65,14 +73,10 @@ foreach $key (keys %news_sites) {
print "Invalid Headline. Usage: .headlines [links] <news server> - News servers are: ";
foreach $key (keys %news_sites) {
print "$key => $news_sites{$key}->[1], ";
}
foreach $key (keys %news_sites) { print "$key => $news_sites{$key}->[1], "; }
print "\n";
sub check_news {
my ($site, $links, $headline) = @_;
my $text = "$headline: ";
@ -82,29 +86,23 @@ sub check_news {
my $content = get($site);
if ($content) {
eval {
$rss->parse($content);
};
eval { $rss->parse($content); };
if (my $error = $@) {
$error =~ s/\n//g;
print "Got error: $error\n";
return 0;
}
foreach my $item (@{$rss->{'items'}}) {
next unless defined($item->{'title'}) && defined($item->{'link'});
if ($links == 1)
{
if ($links == 1) {
$text = " $item->{'title'} : ( $item->{'link'} )";
$text =~ s/\n//g;
$text =~ s/\t//g;
$text =~ s/\r//g;
print "$text\n";
}
else
{
} else {
$text .= " $item->{'title'} -";
}
}

110
modules/ideone.pl vendored
View File

@ -10,6 +10,7 @@ use feature qw(switch);
use SOAP::Lite;
$SOAP::Constants::DO_NOT_USE_XML_PARSER = 1;
use IPC::Open2;
use HTML::Entities;
use Text::Balanced qw(extract_codeblock extract_delimited);
@ -92,8 +93,10 @@ my %languages = (
# C++ 1
my %preludes = (
'34' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'11' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'34' =>
"#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'11' =>
"#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'1' => "#include <iostream>\n#include <cstdio>\n",
);
@ -115,11 +118,8 @@ if (open FILE, "< ideone_last_code.txt") {
}
if ($code =~ m/^\s*show\s*$/i) {
if (defined $last_code[0]) {
print "$nick: $last_code[0]\n";
} else {
print "$nick: No recent code to show.\n"
}
if (defined $last_code[0]) { print "$nick: $last_code[0]\n"; }
else { print "$nick: No recent code to show.\n" }
exit 0;
}
@ -309,15 +309,16 @@ if ($code =~ m/^\s*run\s*$/i) {
print "$nick: Bad regex modifier '$suffix'. Only 'i' and 'g' are allowed.\n";
exit 0;
}
if (defined $prevchange) {
$code = $prevchange;
} else {
if (defined $prevchange) { $code = $prevchange; }
else {
print "$nick: No recent code to change.\n";
exit 0;
}
my $ret = eval {
my $ret;
my $a;
my $b;
my $c;
@ -406,9 +407,7 @@ if ($code =~ m/^\s*run\s*$/i) {
exit 0;
}
if ($ret) {
$got_changes = 1;
}
if ($ret) { $got_changes = 1; }
$prevchange = $code;
}
@ -434,14 +433,11 @@ if ($code =~ m/^\s*run\s*$/i) {
my $modifier = $replacement->{'modifier'};
if (defined $previous_from) {
if ($previous_from eq $from and $previous_modifier =~ /^\d+$/) {
$modifier -= $modifier - $previous_modifier;
}
if ($previous_from eq $from and $previous_modifier =~ /^\d+$/) { $modifier -= $modifier - $previous_modifier; }
}
if (defined $prevchange) {
$code = $prevchange;
} else {
if (defined $prevchange) { $code = $prevchange; }
else {
print "$nick: No recent code to change.\n";
exit 0;
}
@ -453,33 +449,21 @@ if ($code =~ m/^\s*run\s*$/i) {
$first_char = $1 if $from =~ m/^(.)/;
$last_char = $1 if $from =~ m/(.)$/;
if ($first_char =~ /\W/) {
$first_bound = '.';
} else {
$first_bound = '\b';
}
if ($first_char =~ /\W/) { $first_bound = '.'; }
else { $first_bound = '\b'; }
if ($last_char =~ /\W/) {
$last_bound = '\B';
} else {
$last_bound = '\b';
}
if ($last_char =~ /\W/) { $last_bound = '\B'; }
else { $last_bound = '\b'; }
if ($modifier eq 'all') {
while ($code =~ s/($first_bound)$from($last_bound)/$1$to$2/) {
$got_change = 1;
}
while ($code =~ s/($first_bound)$from($last_bound)/$1$to$2/) { $got_change = 1; }
} elsif ($modifier eq 'last') {
if ($code =~ s/(.*)($first_bound)$from($last_bound)/$1$2$to$3/) {
$got_change = 1;
}
if ($code =~ s/(.*)($first_bound)$from($last_bound)/$1$2$to$3/) { $got_change = 1; }
} else {
my $count = 0;
my $unescaped = $from;
$unescaped =~ s/\\//g;
if ($code =~ s/($first_bound)$from($last_bound)/if (++$count == $modifier) { "$1$to$2"; } else { "$1$unescaped$2"; }/gex) {
$got_change = 1;
}
if ($code =~ s/($first_bound)$from($last_bound)/if (++$count == $modifier) { "$1$to$2"; } else { "$1$unescaped$2"; }/gex) { $got_change = 1; }
}
return $got_change;
};
@ -507,9 +491,7 @@ if ($code =~ m/^\s*run\s*$/i) {
open FILE, "> ideone_last_code.txt";
unless ($got_undo and not $got_sub) {
unshift @last_code, $code;
}
unless ($got_undo and not $got_sub) { unshift @last_code, $code; }
my $i = 0;
foreach my $line (@last_code) {
@ -598,9 +580,14 @@ if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{
$code = $precode;
}
if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 35
or $languages{$lang}{'id'} == 27 or $languages{$lang}{'id'} == 10 or $languages{$lang}{'id'} == 34) {
$code = pretty($code)
if ( $languages{$lang}{'id'} == 1
or $languages{$lang}{'id'} == 11
or $languages{$lang}{'id'} == 35
or $languages{$lang}{'id'} == 27
or $languages{$lang}{'id'} == 10
or $languages{$lang}{'id'} == 34)
{
$code = pretty($code);
}
$code =~ s/\\n/\n/g if $languages{$lang}{'id'} == 13 or $languages{$lang}{'id'} == 101 or $languages{$lang}{'id'} == 45;
@ -709,30 +696,18 @@ if ($result->{result} != $SUCCESSFUL or $languages{$lang}{'id'} == 13) {
if ($result->{result} == $RUNTIME_ERROR) {
$output .= "\n[Runtime error]";
if ($result->{signal}) {
$output .= "\n[Signal: $signame[$result->{signal}] ($result->{signal})]";
}
if ($result->{signal}) { $output .= "\n[Signal: $signame[$result->{signal}] ($result->{signal})]"; }
} else {
if ($result->{signal}) {
$output .= "\n[Exit code: $result->{signal}]";
}
if ($result->{signal}) { $output .= "\n[Exit code: $result->{signal}]"; }
}
if ($result->{result} == $TIMELIMIT) {
$output .= "\n[Time limit exceeded]";
}
if ($result->{result} == $TIMELIMIT) { $output .= "\n[Time limit exceeded]"; }
if ($result->{result} == $MEMORYLIMIT) {
$output .= "\n[Out of memory]";
}
if ($result->{result} == $MEMORYLIMIT) { $output .= "\n[Out of memory]"; }
if ($result->{result} == $ILLEGAL_SYSCALL) {
$output .= "\n[Disallowed system call]";
}
if ($result->{result} == $ILLEGAL_SYSCALL) { $output .= "\n[Disallowed system call]"; }
if ($result->{result} == $INTERNAL_ERROR) {
$output .= "\n[Internal error]";
}
if ($result->{result} == $INTERNAL_ERROR) { $output .= "\n[Internal error]"; }
$output .= "\n" . $result->{stderr};
$output .= "\n" . $result->{output};
@ -760,11 +735,8 @@ unless ($got_run) {
close FILE;
}
if ($show_link) {
print "$nick: [ http://ideone.com/$url ] $output\n";
} else {
print "$nick: $output\n";
}
if ($show_link) { print "$nick: [ http://ideone.com/$url ] $output\n"; }
else { print "$nick: $output\n"; }
# ---------------------------------------------
@ -794,9 +766,7 @@ sub pretty {
my $pid = open2(\*IN, \*OUT, 'astyle -xUpf');
print OUT "$code\n";
close OUT;
while (my $line = <IN>) {
$result .= $line;
}
while (my $line = <IN>) { $result .= $line; }
close IN;
waitpid($pid, 0);
return $result;

3
modules/insult.pl vendored
View File

@ -11,7 +11,6 @@ $_ = get("http://www.randominsults.net/");
if (/<strong><i>(.*?)\s*<\/i><\/strong>/) {
print "@ARGV", ': ' if @ARGV;
print "$1\n";
}
else {
} else {
print "yo momma!";
}

230
modules/lookupbot.pl vendored
View File

@ -15,7 +15,8 @@ my %IRSSI = (
'contact' => 'craig@simplyspiffing.com',
'name' => 'lookupbot',
'description' => 'Some kind of magical internet searcher',
'license' => 'Craig\'s Magical Freebie License');
'license' => 'Craig\'s Magical Freebie License'
);
## Changes ##
# 0.0.1 - Initial version, not very good
@ -56,6 +57,7 @@ sub get_data {
# $escape - URL encode the data before insertion? 1 = true, 0 = false
##
my %url_cache;
sub get_content {
my ($url, $data, $escape, $cache) = @_;
@ -64,10 +66,7 @@ sub get_content {
# Use the cache if requested
my $timeout = time() - $cache;
if (defined $cache &&
$cache > 0 &&
exists $url_cache{$url} &&
$url_cache{$url}->{'time'} > $timeout) {
if (defined $cache && $cache > 0 && exists $url_cache{$url} && $url_cache{$url}->{'time'} > $timeout) {
return $url_cache{$url}->{'content'};
}
@ -76,12 +75,9 @@ sub get_content {
my $result = $ua->get($url, ('Accept-Charset' => 'utf-8,iso-8859-1,*'));
my $content;
if ($result->is_success)
{
if ($result->is_success) {
my $encoding = $result->content_encoding;
if ($encoding eq "") {
$encoding = is_utf8($result->content)?'utf-8':'iso-8859-1';
}
if ($encoding eq "") { $encoding = is_utf8($result->content) ? 'utf-8' : 'iso-8859-1'; }
$content = decode($encoding, $result->content()) if $result->is_success;
$url_cache{$url} = {'time' => time(), 'content' => $content};
}
@ -140,18 +136,16 @@ sub urban_search {
my $def_word = 0;
my $paragraphs = 0;
while ($def_word <= 1 &&
$paragraphs <= 4 &&
scalar(@lines) > 0) {
while ($def_word <= 1 && $paragraphs <= 4 && scalar(@lines) > 0) {
my $s = shift(@lines);
$s =~ s/^\s*//;
$s =~ s/\s*$//;
$s =~ s/<.+?>//g;
if ($s =~ /(meaning|definition|def_p)/) {
$def_word++;
} elsif ($s =~ /example/) {
if ($s =~ /(meaning|definition|def_p)/) { $def_word++; }
elsif ($s =~ /example/) {
# Do nothing
} elsif (length $s > 0) {
$definition .= "$s\n";
@ -219,11 +213,8 @@ sub wwotd_search {
my @result;
while ($blanks > 0 && scalar(@lines)) {
my $line = shift @lines;
if (length $line) {
push @result, $line;
} else {
$blanks --;
}
if (length $line) { push @result, $line; }
else { $blanks--; }
}
return join "\n", @result;
@ -232,6 +223,7 @@ sub wwotd_search {
##
# Dictionary.com word of the day
##
=cut
sub wotd_search {
my $content = shift;
@ -244,6 +236,7 @@ sub wotd_search {
return join ("\n", @lines);
}
=cut
##
# Sloganizer
##
@ -282,9 +275,7 @@ sub insult_search {
sub limerick_preprocessor {
my $parameter = shift;
if (!defined($parameter) || $parameter == 0) {
$parameter = 'random';
}
if (!defined($parameter) || $parameter == 0) { $parameter = 'random'; }
return $parameter;
}
@ -305,9 +296,7 @@ sub limerick_search {
sub bash_preprocessor {
my $parameter = shift;
if (!defined($parameter) || $parameter == 0) {
$parameter = 'random';
}
if (!defined($parameter) || $parameter == 0) { $parameter = 'random'; }
return $parameter;
}
@ -327,9 +316,7 @@ sub bash_search {
sub memetic_preprocessor {
my $parameter = shift;
if (!defined($parameter) || $parameter == 0) {
$parameter = 'random';
}
if (!defined($parameter) || $parameter == 0) { $parameter = 'random'; }
return $parameter;
}
@ -348,7 +335,9 @@ sub memetic_search {
# Only really useful as a privmsg
##
sub tinyurl_search {
my $content = shift;
my $term = shift;
my $server = shift;
my $nick = shift;
@ -356,9 +345,8 @@ sub tinyurl_search {
my @lines = $content =~ /<blockquote><b>(.+?)</gism;
my $result = '';
if (scalar(@lines)) {
$result = $lines[1];
}
if (scalar(@lines)) { $result = $lines[1]; }
return $result;
}
@ -388,8 +376,7 @@ sub cndb_search {
my @raw = $content =~ m/class="bold">(.+?)<\/td>/gosm;
return "" unless scalar(@raw);
my @lines;
while (scalar(@raw) &&
$raw[0] !~ /(was this review helpful|login to rate this review|^\s*$)/i) {
while (scalar(@raw) && $raw[0] !~ /(was this review helpful|login to rate this review|^\s*$)/i) {
my $l = shift @raw;
push @lines, $l if $l !~ /\&nbsp;/;
@ -525,9 +512,7 @@ sub tdm_search {
my @lines = $content =~ /<item>(.+?)<\/item>/gosm;
my $id = rand(scalar(@lines));
if ($term =~ /^\d+$/ &&
$term > 0 &&
$term <= scalar(@lines)) {
if ($term =~ /^\d+$/ && $term > 0 && $term <= scalar(@lines)) {
$id = $term - 1;
}
@ -544,7 +529,6 @@ sub tdm_search {
return "$item[0]\n$item[2]\n$url";
}
##
# Random proverbs
##
@ -571,73 +555,124 @@ sub proverb_search {
# messages (i.e. 'in channel') the trigger must be prefixed by !
# The only 'private only' responder at the moment is tinyurl
###
my %ENGINES = ('!image' => {'url' => 'http://images.google.co.uk/images?hl=en&safe=off&q=%s',
my %ENGINES = (
'!image' => {
'url' => 'http://images.google.co.uk/images?hl=en&safe=off&q=%s',
'sub' => \&image_search,
'cache' => 600},
'!google' => {'url' => 'http://www.google.co.uk/search?hl=en&q=%s',
'sub' => \&google_search},
'!define' => {'url' => 'http://www.google.co.uk/search?hl=en&q=define%%3A%%20%s',
'sub' => \&define_search},
'!urban' => {'url' => 'http://www.urbandictionary.com/define.php?term=%s',
'cache' => 600
},
'!google' => {
'url' => 'http://www.google.co.uk/search?hl=en&q=%s',
'sub' => \&google_search
},
'!define' => {
'url' => 'http://www.google.co.uk/search?hl=en&q=define%%3A%%20%s',
'sub' => \&define_search
},
'!urban' => {
'url' => 'http://www.urbandictionary.com/define.php?term=%s',
'sub' => \&urban_search,
'cache' => 60},
'!profan' => {'url' => 'http://www.viz.co.uk/profanisaurus/profan_results.php?profan=search&prof_search=%s',
'sub' => \&profan_search},
'!uwotd' => {'url' => 'http://feeds.urbandictionary.com/UrbanWordOfTheDay',
'cache' => 60
},
'!profan' => {
'url' => 'http://www.viz.co.uk/profanisaurus/profan_results.php?profan=search&prof_search=%s',
'sub' => \&profan_search
},
'!uwotd' => {
'url' => 'http://feeds.urbandictionary.com/UrbanWordOfTheDay',
'sub' => \&uwotd_search,
'cache' => 3600},
'!wwotd' => {'url' => 'http://home.comcast.net/~wwftd/Frame1.html',
'cache' => 3600
},
'!wwotd' => {
'url' => 'http://home.comcast.net/~wwftd/Frame1.html',
'sub' => \&wwotd_search,
'cache' => 3600},
'!wotd' => {'url' => 'http://dictionary.reference.com/wordoftheday/',
'cache' => 3600
},
'!wotd' => {
'url' => 'http://dictionary.reference.com/wordoftheday/',
'sub' => \&wotd_search,
'cache' => 3600},
'!slogan' => {'url' => 'http://www.sloganizer.net/en/?slogan=%s',
'sub' => \&slogan_search},
'!insult' => {'url' => 'http://www.webinsult.com/',
'sub' => \&insult_search},
'!compliment' => {'url' => 'http://www.madsci.org/cgi-bin/cgiwrap/~lynn/jardin/SCG/',
'sub' => \&compliment_search},
'!limerick' => {'url' => 'http://limerickdb.com/?%s',
'cache' => 3600
},
'!slogan' => {
'url' => 'http://www.sloganizer.net/en/?slogan=%s',
'sub' => \&slogan_search
},
'!insult' => {
'url' => 'http://www.webinsult.com/',
'sub' => \&insult_search
},
'!compliment' => {
'url' => 'http://www.madsci.org/cgi-bin/cgiwrap/~lynn/jardin/SCG/',
'sub' => \&compliment_search
},
'!limerick' => {
'url' => 'http://limerickdb.com/?%s',
'sub' => \&limerick_search,
'pre' => \&limerick_preprocessor},
'!bash' => {'url' => 'http://bash.org/?%s',
'pre' => \&limerick_preprocessor
},
'!bash' => {
'url' => 'http://bash.org/?%s',
'sub' => \&bash_search,
'pre' => \&bash_preprocessor},
'!memetic' => {'url' => 'http://www.memetic.org/%s',
'pre' => \&bash_preprocessor
},
'!memetic' => {
'url' => 'http://www.memetic.org/%s',
'sub' => \&memetic_search,
'pre' => \&memetic_preprocessor},
'!cricket' => {'url' => 'http://www.cricinfo.com/rss/livescores.xml',
'sub' => \&cricket_search},
'tinyurl' => {'url' => 'http://tinyurl.com/create.php?url=%s',
'pre' => \&memetic_preprocessor
},
'!cricket' => {
'url' => 'http://www.cricinfo.com/rss/livescores.xml',
'sub' => \&cricket_search
},
'tinyurl' => {
'url' => 'http://tinyurl.com/create.php?url=%s',
'sub' => \&tinyurl_search,
'escape' => 0,
'cache' => 3600},
'!cndb' => {'url' => 'http://cndb.com/actor.html?name=%s',
'cache' => 3600
},
'!cndb' => {
'url' => 'http://cndb.com/actor.html?name=%s',
'sub' => \&cndb_search,
'pre' => \&cndb_preprocessor,
'cache' => 3600},
'!horoscope' => {'url' => 'http://www.astrology-online.com/daily.htm',
'cache' => 3600
},
'!horoscope' => {
'url' => 'http://www.astrology-online.com/daily.htm',
'sub' => \&horoscope_search,
'cache' => 3600},
'!horrorscope' => {'url' => 'http://www.emilystrange.com/beware/horrorscopes.cfm',
'cache' => 3600
},
'!horrorscope' => {
'url' => 'http://www.emilystrange.com/beware/horrorscopes.cfm',
'sub' => \&horrorscope_search,
'cache' => 3600},
'!bored' => {'url' => 'http://www.bored.com/',
'cache' => 3600
},
'!bored' => {
'url' => 'http://www.bored.com/',
'sub' => \&bored_search,
'cache' => 3600},
'!procrastinate' => {'url' => 'http://www.bored.com/',
'cache' => 3600
},
'!procrastinate' => {
'url' => 'http://www.bored.com/',
'sub' => \&bored_search,
'cache' => 3600},
'cache' => 3600
},
#'!sick' => {'url' => 'http://sickipedia.org/feeds/?1195996408.xml',
# 'sub' => \&sick_search},
'!joke' => {'url' => 'http://www.ajokeaday.com/ChisteAlAzar.asp',
'sub' => \&joke_search},
'!tdm' => {'url' => 'http://www.thedailymash.co.uk/rss.xml',
'!joke' => {
'url' => 'http://www.ajokeaday.com/ChisteAlAzar.asp',
'sub' => \&joke_search
},
'!tdm' => {
'url' => 'http://www.thedailymash.co.uk/rss.xml',
'sub' => \&tdm_search,
'cache' => 3600},
'!proverb' => {'url' => 'http://server52204.uk2net.com/b3taproverbs/',
'sub' => \&proverb_search});
'cache' => 3600
},
'!proverb' => {
'url' => 'http://server52204.uk2net.com/b3taproverbs/',
'sub' => \&proverb_search
}
);
sub process_request {
my ($trigger, $term, $server, $nick, $target) = @_;
@ -647,12 +682,9 @@ sub process_request {
my $url = $ENGINES{$trigger}->{'url'};
my $sub = $ENGINES{$trigger}->{'sub'};
my $pre = exists $ENGINES{$trigger}->{'pre'} ?
$ENGINES{$trigger}->{'pre'} : undef;
my $escape = exists $ENGINES{$trigger}->{'escape'} ?
$ENGINES{$trigger}->{'escape'} : 1;
my $cache = exists $ENGINES{$trigger}->{'cache'} ?
$ENGINES{$trigger}->{'cache'} : 0;
my $pre = exists $ENGINES{$trigger}->{'pre'} ? $ENGINES{$trigger}->{'pre'} : undef;
my $escape = exists $ENGINES{$trigger}->{'escape'} ? $ENGINES{$trigger}->{'escape'} : 1;
my $cache = exists $ENGINES{$trigger}->{'cache'} ? $ENGINES{$trigger}->{'cache'} : 0;
# Pre-process the parameter if a pre function is defined
$term = $pre->($term) if defined $pre;
@ -662,9 +694,8 @@ sub process_request {
# Get the results of the search
$result = $sub->($content, $term, $server, $nick, $target) if defined $content;
}
else
{
} else {
# Quit if this isn't for us
return undef;
}
@ -727,8 +758,7 @@ sub public_responder {
# Display if necessary
if (@lines) {
$server->command("msg $target -!- $_")
for grep { /./ } @lines;
$server->command("msg $target -!- $_") for grep { /./ } @lines;
}
}
@ -759,9 +789,7 @@ sub main {
my $result = join(' ', @lines);
if ($term ne "") {
print "$term: ";
}
if ($term ne "") { print "$term: "; }
print $result . "\n";
}

Some files were not shown because too many files have changed in this diff Show More