GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-12-23 11:12:42 +01:00
Code Issues Projects Releases Wiki Activity

Update plugins to use subroutine signatures

Browse Source
This commit is contained in:
Pragmatic Software 2023-04-13 17:01:23 -07:00
parent afd07bcd57
commit cd60ac9fc7
34 changed files with 557 additions and 1005 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
lib/PBot/Plugin/ActionTrigger.pm
View File

@ -43,9 +43,7 @@ use DBI;
use Time::Duration qw/duration/;
use Time::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register bot command
$self->{pbot}->{commands}->add(
name => 'actiontrigger',
@ -73,9 +71,7 @@ sub initialize {
$self->create_database;
}
sub unload {
my ($self) = @_;
sub unload($self) {
# close database
$self->dbi_end;
@ -94,9 +90,7 @@ sub unload {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.kick');
}
sub cmd_actiontrigger {
my ($self, $context) = @_;
sub cmd_actiontrigger($self, $context) {
# database not available
return "Internal error." if not $self->{dbh};
@ -253,9 +247,7 @@ sub cmd_actiontrigger {
}
}
sub create_database {
my $self = shift;
sub create_database($self) {
return if not $self->{dbh};
eval {
@ -275,9 +267,7 @@ SQL
$self->{pbot}->{logger}->log("ActionTrigger create database failed: $@") if $@;
}
sub dbi_begin {
my ($self) = @_;
sub dbi_begin($self) {
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
or die $DBI::errstr;
@ -291,16 +281,13 @@ sub dbi_begin {
}
}
sub dbi_end {
my ($self) = @_;
sub dbi_end($self) {
return if not $self->{dbh};
$self->{dbh}->disconnect;
delete $self->{dbh};
}
sub add_trigger {
my ($self, $channel, $trigger, $action, $owner, $cap_override, $ratelimit) = @_;
sub add_trigger($self, $channel, $trigger, $action, $owner, $cap_override, $ratelimit) {
return 0 if $self->get_trigger($channel, $trigger);
eval {
@ -316,17 +303,14 @@ sub add_trigger {
return 1;
}
sub delete_trigger {
my ($self, $channel, $trigger) = @_;
sub delete_trigger($self, $channel, $trigger) {
return 0 if not $self->get_trigger($channel, $trigger);
my $sth = $self->{dbh}->prepare('DELETE FROM Triggers WHERE channel = ? AND trigger = ?');
$sth->execute(lc $channel, $trigger);
return 1;
}
sub list_triggers {
my ($self, $channel) = @_;
sub list_triggers($self, $channel) {
my $triggers = eval {
my $sth;
@ -347,9 +331,7 @@ sub list_triggers {
return @$triggers;
}
sub update_trigger {
my ($self, $channel, $trigger, $data) = @_;
sub update_trigger($self, $channel, $trigger, $data) {
eval {
my $sql = 'UPDATE Triggers SET ';
@ -374,9 +356,7 @@ sub update_trigger {
$self->{pbot}->{logger}->log("Update trigger $channel/$trigger failed: $@\n") if $@;
}
sub get_trigger {
my ($self, $channel, $trigger) = @_;
sub get_trigger($self, $channel, $trigger) {
my $row = eval {
my $sth = $self->{dbh}->prepare('SELECT * FROM Triggers WHERE channel = ? AND trigger = ?');
$sth->execute(lc $channel, $trigger);
@ -392,9 +372,7 @@ sub get_trigger {
return $row;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
sub on_kick($self, $event_type, $event) {
# don't handle this event if it was caused by a bot command
return 0 if $event->{interpreted};
@ -415,9 +393,7 @@ sub on_kick {
return 0;
}
sub on_action {
my ($self, $event_type, $event) = @_;
sub on_action($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = (
$event->nick,
$event->user,
@ -433,14 +409,13 @@ sub on_action {
return 0;
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = (
$event->nick,
$event->user,
$event->host,
$event->args);
$event->args
);
my $channel = $event->{to}[0];
@ -448,9 +423,7 @@ sub on_public {
return 0;
}
sub on_join {
my ($self, $event_type, $event) = @_;
sub on_join($self, $event_type, $event) {
my ($nick, $user, $host, $channel, $args) = (
$event->nick,
$event->user,
@ -463,9 +436,7 @@ sub on_join {
return 0;
}
sub on_departure {
my ($self, $event_type, $event) = @_;
sub on_departure($self, $event_type, $event) {
my ($nick, $user, $host, $channel, $args) = (
$event->nick,
$event->user,
@ -478,9 +449,7 @@ sub on_departure {
return 0;
}
sub check_trigger {
my ($self, $nick, $user, $host, $channel, $text) = @_;
sub check_trigger($self, $nick, $user, $host, $channel, $text) {
# database not available
return 0 if not $self->{dbh};

15
lib/PBot/Plugin/AntiAway.pm
View File

@ -10,9 +10,7 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($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:]]*$|.+\[.*\]$)'
);
@ -24,15 +22,12 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action(@_) });
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.nick');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
}
sub on_nickchange {
my ($self, $event_type, $event) = @_;
sub on_nickchange($self, $event_type, $event) {
my ($nick, $user, $host, $newnick) = (
$event->nick,
$event->user,
@ -60,9 +55,7 @@ sub on_nickchange {
return 0;
}
sub on_action {
my ($self, $event_type, $event) = @_;
sub on_action($self, $event_type, $event) {
my ($nick, $user, $host, $msg, $channel) = (
$event->nick,
$event->user,

12
lib/PBot/Plugin/AntiKickAutoRejoin.pm
View File

@ -13,8 +13,7 @@ use PBot::Imports;
use Time::HiRes qw/gettimeofday/;
use Time::Duration;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{registry}->add_default('array', 'antikickautorejoin', 'punishment', '30,90,180,300,28800');
$self->{pbot}->{registry}->add_default('text', 'antikickautorejoin', 'threshold', '2');
@ -23,14 +22,12 @@ sub initialize {
$self->{kicks} = {};
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.kick');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.join');
}
sub on_kick {
my ($self, $event_type, $event) = @_;
sub on_kick($self, $event_type, $event) {
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
my ($target, $channel, $reason) = ($event->to, $event->{args}[0], $event->{args}[1]);
@ -46,8 +43,7 @@ sub on_kick {
return 0;
}
sub on_join {
my ($self, $event_type, $event) = @_;
sub on_join($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
$channel = lc $channel;

20
lib/PBot/Plugin/AntiNickSpam.pm
View File

@ -14,21 +14,18 @@ use PBot::Imports;
use Time::Duration qw/duration/;
use Time::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action(@_) });
$self->{nicks} = {};
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
}
sub on_action {
my ($self, $event_type, $event) = @_;
sub on_action($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
my $channel = $event->{to}[0];
return 0 if $event->{interpreted};
@ -36,8 +33,7 @@ sub on_action {
return 0;
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
my $channel = $event->{to}[0];
return 0 if $event->{interpreted};
@ -45,8 +41,7 @@ sub on_public {
return 0;
}
sub check_flood {
my ($self, $nick, $user, $host, $channel, $msg) = @_;
sub check_flood($self, $nick, $user, $host, $channel, $msg) {
return 0 if not $self->{pbot}->{chanops}->can_gain_ops($channel);
$channel = lc $channel;
@ -76,10 +71,9 @@ sub check_flood {
}
}
sub clear_old_nicks {
my ($self, $channel) = @_;
my $now = gettimeofday;
sub clear_old_nicks($self, $channel) {
return if not exists $self->{nicks}->{$channel};
my $now = gettimeofday;
while (1) {
if (@{$self->{nicks}->{$channel}} and $self->{nicks}->{$channel}->[0]->[0] <= $now - 15) {

10
lib/PBot/Plugin/AntiRepeat.pm
View File

@ -14,8 +14,7 @@ use String::LCSS qw/lcss/;
use Time::HiRes qw/gettimeofday/;
use POSIX qw/strftime/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat', $conf{antirepeat} // 1);
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat_threshold', $conf{antirepeat_threshold} // 2.5);
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat_match', $conf{antirepeat_match} // 0.5);
@ -27,16 +26,13 @@ sub initialize {
$self->{offenses} = {};
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{event_queue}->dequeue_event('antirepeat .*');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = (
$event->nick,
$event->user,

9
lib/PBot/Plugin/AntiTwitter.pm
View File

@ -14,20 +14,17 @@ use PBot::Imports;
use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/duration/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
$self->{offenses} = {};
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
$self->{pbot}->{event_queue}->dequeue_event('antitwitter .*');
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $channel, $msg) = ($event->nick, $event->user, $event->host, $event->{to}[0], $event->args);
return 0 if $event->{interpreted};

20
lib/PBot/Plugin/AutoRejoin.pm
View File

@ -8,26 +8,24 @@
package PBot::Plugin::AutoRejoin;
use parent 'PBot::Plugin::Base';
use PBot::Imports;
use Time::HiRes qw/gettimeofday/;
use Time::Duration;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{registry}->add_default('array', 'autorejoin', 'rejoin_delay', '900,1800,3600');
$self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_part(@_) });
$self->{rejoins} = {};
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.kick');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.part');
}
sub rejoin_channel {
my ($self, $channel) = @_;
sub rejoin_channel($self, $channel) {
if (not exists $self->{rejoins}->{$channel}) {
$self->{rejoins}->{$channel}->{rejoins} = 0;
}
@ -45,9 +43,7 @@ sub rejoin_channel {
$self->{rejoins}->{$channel}->{last_rejoin} = gettimeofday;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
sub on_kick($self, $event_type, $event) {
my ($nick, $user, $host, $target, $channel, $reason) = (
$event->nick,
$event->user,
@ -67,9 +63,7 @@ sub on_kick {
return 1;
}
sub on_part {
my ($self, $event_type, $event) = @_;
sub on_part($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = (
$event->nick,
$event->user,

8
lib/PBot/Plugin/Base.pm
View File

@ -2,20 +2,18 @@
#
# Purpose: Base class for PBot plugins.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::Base;
use PBot::Imports;
sub new {
my ($class, %args) = @_;
sub new($class, %args) {
if (not exists $args{pbot}) {
my ($package, $filename, $line) = caller(0);
my (undef, undef, undef, $subroutine) = caller(1);
Carp::croak("Missing pbot reference to " . $class . ", created by $subroutine at $filename:$line");
Carp::croak("Missing pbot reference to $class, created by $subroutine at $filename:$line");
}
my $self = bless {}, $class;

124
lib/PBot/Plugin/Battleship.pm
View File

@ -59,9 +59,7 @@ my %color = (
reset => "\x0F",
);
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# register `battleship` bot command
$self->{pbot}->{commands}->add(
name => 'battleship',
@ -128,9 +126,7 @@ sub initialize {
);
}
sub unload {
my ($self) = @_;
sub unload($self) {
# unregister `battleship` bot command
$self->{pbot}->{commands}->remove('battleship');
@ -148,9 +144,7 @@ sub unload {
# disconnected with 'excess flood'). this event handler resumes the game once
# the boards have finished transmitting, unless the game was manually paused
# by a player.
sub on_output_queue_empty {
my ($self) = @_; # we don't care about the other event arguments
sub on_output_queue_empty($self, $event_type, $event) {
# if we're paused waiting for the output queue, go ahead and unpause
if ($self->{state_data}->{paused} == $self->{PAUSED_FOR_OUTPUT_QUEUE}) {
$self->{state_data}->{paused} = 0;
@ -160,9 +154,7 @@ sub on_output_queue_empty {
}
# `battleship` bot command
sub cmd_battleship {
my ($self, $context) = @_;
sub cmd_battleship($self, $context) {
my $usage = "Usage: battleship challenge|accept|decline|ready|unready|bomb|board|score|players|pause|quit|kick|abort; see also: battleship help <command>";
# strip leading and trailing whitespace
@ -485,11 +477,7 @@ sub cmd_battleship {
}
# add a message to PBot output queue, optionally with a delay
sub send_message {
my ($self, $to, $text, $delay) = @_;
$delay //= 0;
sub send_message($self, $to, $text, $delay = 0) {
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $message = {
@ -506,16 +494,13 @@ sub send_message {
}
# get unambiguous internal id for player hostmask
sub get_player_id {
my ($self, $nick, $user, $host) = @_;
sub get_player_id($self, $nick, $user, $host) {
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
return $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($id);
}
# create a new player hash
sub new_player {
my ($self, $id, $nick) = @_;
sub new_player($self, $id, $nick) {
return {
id => $id,
name => $nick,
@ -533,15 +518,13 @@ sub new_player {
}
# get a random number interval [lower, upper)
sub number {
my ($self, $lower, $upper) = @_;
sub number($self, $lower, $upper) {
return int rand($upper - $lower) + $lower;
}
# battleship stuff
sub begin_game_loop {
my ($self) = @_;
sub begin_game_loop($self) {
# add `battleship loop` event repeating at 1s interval
$self->{pbot}->{event_queue}->enqueue_event(
sub {
@ -551,8 +534,7 @@ sub begin_game_loop {
);
}
sub end_game_loop {
my ($self) = @_;
sub end_game_loop($self) {
# remove `battleship loop` event
# repeating events get added back to event queue if we attempt to
@ -564,9 +546,7 @@ sub end_game_loop {
$self->{pbot}->{event_queue}->dequeue_event('battleship loop', 0);
}
sub init_game {
my ($self, $state) = @_;
sub init_game($self, $state) {
# default board dimensions
$self->{N_X} = $self->{BOARD_X};
$self->{N_Y} = $self->{BOARD_Y};
@ -596,9 +576,7 @@ sub init_game {
}
# ensures a ship can be placed at this location (all desired tiles are ocean)
sub check_ship_placement {
my ($self, $x, $y, $o, $l) = @_;
sub check_ship_placement($self, $x, $y, $o, $l) {
my ($xd, $yd, $i);
if ($o == $self->{ORIENT_VERT}) {
@ -625,9 +603,7 @@ sub check_ship_placement {
}
# attempt to place a ship on the battlefield
sub place_ship {
my ($self, $player_id, $player_index, $ship) = @_;
sub place_ship($self, $player_id, $player_index, $ship) {
my ($x, $y, $o, $i, $l);
my ($yd, $xd) = (0, 0);
@ -702,9 +678,7 @@ sub place_ship {
return 0;
}
sub place_whirlpool {
my ($self) = @_;
sub place_whirlpool($self) {
for (my $attempt = 0; $attempt < 1000; $attempt++) {
my $x = $self->number(0, $self->{N_X});
my $y = $self->number(0, $self->{N_Y});
@ -724,9 +698,7 @@ sub place_whirlpool {
return 0;
}
sub generate_battlefield {
my ($self) = @_;
sub generate_battlefield($self) {
# fill board with ocean
for (my $x = 0; $x < $self->{N_X}; $x++) {
for (my $y = 0; $y < $self->{N_Y}; $y++) {
@ -760,9 +732,7 @@ sub generate_battlefield {
}
# we hit a ship; check if the ship has sunk
sub check_sunk {
my ($self, $x, $y) = @_;
sub check_sunk($self, $x, $y) {
# alias to the tile we hit
my $tile = $self->{board}->[$x][$y];
@ -791,9 +761,7 @@ sub check_sunk {
}
}
sub get_attack_text {
my ($self) = @_;
sub get_attack_text($self) {
my @attacks = (
"launches torpedoes at",
"launches nukes at",
@ -810,9 +778,7 @@ sub get_attack_text {
# checks if we hit whirlpool, ocean, ship, etc
# reveals struck whirlpools
sub check_hit {
my ($self, $state, $player, $location_data) = @_;
sub check_hit($self, $state, $player, $location_data) {
my ($x, $y, $location) = (
$location_data->{x},
$location_data->{y},
@ -874,9 +840,7 @@ sub check_hit {
return 0;
}
sub perform_attack {
my ($self, $state, $player) = @_;
sub perform_attack($self, $state, $player) {
$player->{shots}++;
# random attack verb
@ -975,9 +939,7 @@ sub perform_attack {
}
}
sub list_players {
my ($self) = @_;
sub list_players($self) {
my @players;
foreach my $player (@{$self->{state_data}->{players}}) {
@ -989,9 +951,7 @@ sub list_players {
}
}
sub show_scoreboard {
my ($self) = @_;
sub show_scoreboard($self) {
foreach my $player (sort { $b->{health} <=> $a->{health} } @{$self->{state_data}->{players}}) {
next if $player->{removed};
@ -1010,9 +970,7 @@ sub show_scoreboard {
}
}
sub show_battlefield {
my ($self, $player_index, $nick) = @_;
sub show_battlefield($self, $player_index, $nick) {
$self->{pbot}->{logger}->log("Showing battlefield for player $player_index\n");
my $player;
@ -1173,9 +1131,7 @@ sub show_battlefield {
# game state machine stuff
# do one loop of the game engine
sub run_one_state {
my ($self) = @_;
sub run_one_state($self) {
# don't run a game loop if we're paused
if ($self->{state_data}->{paused}) {
return;
@ -1243,17 +1199,14 @@ sub run_one_state {
}
# skip directly to a state
sub set_state {
my ($self, $newstate) = @_;
sub set_state($self, $newstate) {
$self->{previous_state} = $self->{current_state};
$self->{current_state} = $newstate;
$self->{state_data}->{ticks} = 0;
}
# set up game state machine
sub create_states {
my ($self) = @_;
sub create_states($self) {
$self->{pbot}->{logger}->log("Battleship: Creating game state machine\n");
# initialize default state
@ -1321,15 +1274,12 @@ sub create_states {
# game states
sub state_nogame {
my ($self, $state) = @_;
sub state_nogame($self, $state) {
$self->end_game_loop;
$state->{trans} = 'nogame';
}
sub state_challenge {
my ($self, $state) = @_;
sub state_challenge($self, $state) {
# max number of times to perform tock action
$state->{tock_limit} = 5;
@ -1378,9 +1328,7 @@ sub state_challenge {
}
}
sub state_genboard {
my ($self, $state) = @_;
sub state_genboard($self, $state) {
if (!$self->init_game($state)) {
$self->{pbot}->{logger}->log("Failed to generate battlefield\n");
$self->send_message($self->{channel}, "Failed to generate a suitable battlefield. Please try again.");
@ -1391,9 +1339,7 @@ sub state_genboard {
}
}
sub state_showboard {
my ($self, $state) = @_;
sub state_showboard($self, $state) {
# pause the game to send the boards to all the players.
# this is due to output pacing; the messages are trickled out slowly
# to avoid overflowing the ircd's receive queue. we do not want the
@ -1411,9 +1357,7 @@ sub state_showboard {
$state->{trans} = 'next';
}
sub state_move {
my ($self, $state) = @_;
sub state_move($self, $state) {
# allow 5 tocks before players have missed their move
$state->{tock_limit} = 5;
@ -1493,9 +1437,7 @@ sub state_move {
$state->{trans} = 'wait';
}
sub state_attack {
my ($self, $state) = @_;
sub state_attack($self, $state) {
my $trans = 'next';
foreach my $player (@{$state->{players}}) {
@ -1515,9 +1457,7 @@ sub state_attack {
$state->{trans} = $trans;
}
sub state_gameover {
my ($self, $state) = @_;
sub state_gameover($self, $state) {
if (@{$state->{players}} >= 2) {
$self->show_battlefield($self->{BOARD_FINAL});
$self->show_scoreboard;

108
lib/PBot/Plugin/Connect4.pm
View File

@ -20,9 +20,7 @@ $Data::Dumper::Sortkeys = 1;
# This plugin was contributed by mannito, based on an earlier version of Battleship.pm
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'connect4',
help => 'Connect-4 board game',
@ -38,8 +36,7 @@ sub initialize {
$self->create_states;
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->remove('connect4');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.part');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.quit');
@ -47,8 +44,7 @@ sub unload {
$self->{pbot}->{event_queue}->dequeue_event('connect4 loop');
}
sub on_kick {
my ($self, $event_type, $event) = @_;
sub on_kick($self, $event_type, $event) {
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
my ($victim, $reason) = ($event->to, $event->{args}[1]);
my $channel = $event->{args}[0];
@ -57,8 +53,7 @@ sub on_kick {
return 0;
}
sub on_departure {
my ($self, $event_type, $event) = @_;
sub on_departure($self, $event_type, $event) {
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
my $type = uc $event->type;
return 0 if $type ne 'QUIT' and lc $channel ne $self->{channel};
@ -99,8 +94,7 @@ my $MAX_NX = 80;
my $MAX_NY = 12;
# challenge options: CONNS:ROWSxCOLS
sub parse_challenge {
my ($self, $options) = @_;
sub parse_challenge($self, $options) {
my ($conns, $xy, $nx, $ny);
"x" =~ /x/; # clear $1, $2 ...
@ -132,16 +126,18 @@ sub parse_challenge {
return 0;
}
sub cmd_connect4 {
my ($self, $context) = @_;
my $err;
sub cmd_connect4($self, $context) {
$context->{arguments} =~ s/^\s+|\s+$//g;
my $usage = "Usage: connect4 challenge|accept|play|board|quit|players|kick|abort; for more information about a command: connect4 help <command>";
my ($command, $arguments, $options) = split / /, $context->{arguments}, 3;
if (defined $command) {
$command = lc $command;
} else {
$command = '';
}
given ($command) {
when ('help') {
@ -164,6 +160,8 @@ sub cmd_connect4 {
$self->{N_Y} = $DEFAULT_NY;
$self->{CONNECTIONS} = $DEFAULT_CONNECTIONS;
my $err;
if ((not length $arguments) || ($arguments =~ m/^\d+.*$/ && not($err = $self->parse_challenge($arguments)))) {
$self->{current_state} = 'accept';
$self->{state_data} = {players => [], counter => 0};
@ -351,9 +349,7 @@ sub cmd_connect4 {
return "";
}
sub player_left {
my ($self, $nick, $user, $host) = @_;
sub player_left($self, $nick, $user, $host) {
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
my $removed = 0;
@ -371,8 +367,7 @@ sub player_left {
}
}
sub send_message {
my ($self, $to, $text, $delay) = @_;
sub send_message($self, $to, $text, $delay) {
$delay = 0 if not defined $delay;
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $message = {
@ -387,9 +382,7 @@ sub send_message {
$self->{pbot}->{interpreter}->add_message_to_output_queue($to, $message, $delay);
}
sub run_one_state {
my $self = shift;
sub run_one_state($self) {
# check for naughty or missing players
if ($self->{current_state} =~ /(?:move|accept)/) {
my $removed = 0;
@ -461,9 +454,7 @@ sub run_one_state {
$self->{state_data}->{ticks}++;
}
sub create_states {
my $self = shift;
sub create_states($self) {
$self->{pbot}->{logger}->log("Connect4: Creating game state machine\n");
$self->{previous_state} = '';
@ -502,9 +493,7 @@ sub create_states {
# connect4 stuff
sub init_game {
my ($self, $nick1, $nick2) = @_;
sub init_game($self, $nick1, $nick2) {
$self->{chips} = 0;
$self->{draw} = 0;
@ -522,8 +511,7 @@ sub init_game {
$self->generate_board;
}
sub generate_board {
my ($self) = @_;
sub generate_board($self) {
my ($x, $y);
for ($y = 0; $y < $self->{N_Y}; $y++) {
@ -531,8 +519,7 @@ sub generate_board {
}
}
sub check_one {
my ($self, $y, $x, $prev) = @_;
sub check_one($self, $y, $x, $prev) {
my $chip = $self->{board}[$y][$x];
push @{$self->{winner_line}}, "$y $x";
@ -542,8 +529,7 @@ sub check_one {
return (scalar @{$self->{winner_line}} == $self->{CONNECTIONS}, $chip);
}
sub connected {
my ($self) = @_;
sub connected($self) {
my ($i, $j, $row, $col, $prev) = (0, 0, 0, 0, 0);
my $rv;
@ -605,8 +591,7 @@ sub connected {
return 0;
}
sub column_top {
my ($self, $x) = @_;
sub column_top($self, $x) {
my $y;
for ($y = 0; $y < $self->{N_Y}; $y++) {
@ -615,8 +600,7 @@ sub column_top {
return -1; # shouldnt happen
}
sub play {
my ($self, $player, $location) = @_;
sub play($self, $player, $location) {
my ($draw, $c4, $x, $y);
$x = $location - 1;
@ -652,8 +636,7 @@ sub play {
return 1;
}
sub show_board {
my ($self) = @_;
sub show_board($self) {
my ($x, $y, $buf, $chip, $c);
$self->{pbot}->{logger}->log("showing board\n");
@ -683,9 +666,11 @@ sub show_board {
for ($y = 0; $y < $self->{N_Y}; $y++) {
for ($x = 0; $x < $self->{N_X}; $x++) {
$chip = $self->{board}->[$y][$x];
my $rc = "$y $x";
$c = $chip eq 'O' ? $color{red} : $color{yellow};
if (grep(/^$rc$/, @{$self->{winner_line}})) { $c .= $color{bold}; }
$buf .= $color{blue} . "[";
@ -702,16 +687,13 @@ sub show_board {
# state subroutines
sub nogame {
my ($self, $state) = @_;
sub nogame($self, $state) {
$state->{result} = 'nogame';
$self->{pbot}->{event_queue}->update_repeating('connect4 loop', 0);
return $state;
}
sub accept {
my ($self, $state) = @_;
sub accept($self, $state) {
$state->{max_count} = 3;
if ($state->{players}->[1]->{accepted}) {
@ -743,16 +725,14 @@ sub accept {
return $state;
}
sub genboard {
my ($self, $state) = @_;
sub genboard($self, $state) {
$self->init_game($state->{players}->[0]->{name}, $state->{players}->[1]->{name});
$state->{max_count} = 3;
$state->{result} = 'next';
return $state;
}
sub showboard {
my ($self, $state) = @_;
sub showboard($self, $state) {
$self->send_message($self->{channel}, "Showing board ...");
$self->show_board;
$self->send_message($self->{channel}, "Fight! Anybody (players and spectators) can use `board` at any time to see latest version of the board!");
@ -760,12 +740,14 @@ sub showboard {
return $state;
}
sub playermove {
my ($self, $state) = @_;
sub playermove($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");
@ -798,20 +780,18 @@ sub playermove {
return $state;
}
sub checkplayer {
my ($self, $state) = @_;
if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) { $state->{result} = 'end'; }
else { $state->{result} = 'next'; }
sub checkplayer($self, $state) {
if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) {
$state->{result} = 'end';
} else {
$state->{result} = 'next';
}
return $state;
}
sub gameover {
my ($self, $state) = @_;
my $buf;
sub gameover($self, $state) {
if ($state->{ticks} % 2 == 0) {
$self->show_board;
$self->send_message($self->{channel}, $buf);
$self->send_message($self->{channel}, "Game over!");
$state->{players} = [];
$state->{counter} = 0;

157
lib/PBot/Plugin/Counter.pm
View File

@ -15,8 +15,7 @@ use DBI;
use Time::Duration qw/duration/;
use Time::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->register(sub { $self->cmd_counteradd(@_) }, 'counteradd', 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_counterdel(@_) }, 'counterdel', 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_counterreset(@_) }, 'counterreset', 0);
@ -31,8 +30,7 @@ sub initialize {
$self->create_database;
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->unregister('counteradd');
$self->{pbot}->{commands}->unregister('counterdel');
$self->{pbot}->{commands}->unregister('counterreset');
@ -43,9 +41,7 @@ sub unload {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
}
sub create_database {
my $self = shift;
sub create_database($self) {
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
or die $DBI::errstr;
@ -76,8 +72,7 @@ SQL
$self->{pbot}->{logger}->log("Counter create database failed: $@") if $@;
}
sub dbi_begin {
my ($self) = @_;
sub dbi_begin($self) {
eval { $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1}) or die $DBI::errstr; };
if ($@) {
@ -88,27 +83,26 @@ sub dbi_begin {
}
}
sub dbi_end {
my ($self) = @_;
sub dbi_end($self) {
$self->{dbh}->disconnect;
}
sub add_counter {
my ($self, $owner, $channel, $name, $description) = @_;
sub add_counter($self, $owner, $channel, $name, $description) {
my ($desc, $timestamp) = $self->get_counter($channel, $name);
if (defined $desc) { return 0; }
eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Counters (channel, name, description, timestamp, created_on, created_by, counter) VALUES (?, ?, ?, ?, ?, ?, ?)');
$sth->bind_param(1, lc $channel);
$sth->bind_param(2, lc $name);
$sth->bind_param(3, $description);
$sth->bind_param(4, scalar gettimeofday);
$sth->bind_param(5, scalar gettimeofday);
$sth->bind_param(6, $owner);
$sth->bind_param(7, 0);
$sth->execute();
$sth->execute(
lc $channel,
lc $name,
$description,
scalar gettimeofday,
scalar gettimeofday,
$owner,
0,
);
};
if ($@) {
@ -118,9 +112,7 @@ sub add_counter {
return 1;
}
sub reset_counter {
my ($self, $channel, $name) = @_;
sub reset_counter($self, $channel, $name) {
my ($description, $timestamp, $counter) = $self->get_counter($channel, $name);
if (not defined $description) { return (undef, undef); }
@ -140,9 +132,7 @@ sub reset_counter {
return ($description, $timestamp);
}
sub delete_counter {
my ($self, $channel, $name) = @_;
sub delete_counter($self, $channel, $name) {
my ($description, $timestamp) = $self->get_counter($channel, $name);
if (not defined $description) { return 0; }
@ -160,9 +150,7 @@ sub delete_counter {
return 1;
}
sub list_counters {
my ($self, $channel) = @_;
sub list_counters($self, $channel) {
my $counters = eval {
my $sth = $self->{dbh}->prepare('SELECT name FROM Counters WHERE channel = ?');
$sth->bind_param(1, lc $channel);
@ -174,9 +162,7 @@ sub list_counters {
return map { $_->[0] } @$counters;
}
sub get_counter {
my ($self, $channel, $name) = @_;
sub get_counter($self, $channel, $name) {
my ($description, $time, $counter, $created_on, $created_by) = eval {
my $sth = $self->{dbh}->prepare('SELECT description, timestamp, counter, created_on, created_by FROM Counters WHERE channel = ? AND name = ?');
$sth->bind_param(1, lc $channel);
@ -193,9 +179,7 @@ sub get_counter {
return ($description, $time, $counter, $created_on, $created_by);
}
sub add_trigger {
my ($self, $channel, $trigger, $target) = @_;
sub add_trigger($self, $channel, $trigger, $target) {
my $exists = $self->get_trigger($channel, $trigger);
if (defined $exists) { return 0; }
@ -214,9 +198,7 @@ sub add_trigger {
return 1;
}
sub delete_trigger {
my ($self, $channel, $trigger) = @_;
sub delete_trigger($self, $channel, $trigger) {
my $target = $self->get_trigger($channel, $trigger);
if (not defined $target) { return 0; }
@ -227,9 +209,7 @@ sub delete_trigger {
return 1;
}
sub list_triggers {
my ($self, $channel) = @_;
sub list_triggers($self, $channel) {
my $triggers = eval {
my $sth = $self->{dbh}->prepare('SELECT trigger, target FROM Triggers WHERE channel = ?');
$sth->bind_param(1, lc $channel);
@ -241,9 +221,7 @@ sub list_triggers {
return @$triggers;
}
sub get_trigger {
my ($self, $channel, $trigger) = @_;
sub get_trigger($self, $channel, $trigger) {
my $target = eval {
my $sth = $self->{dbh}->prepare('SELECT target FROM Triggers WHERE channel = ? AND trigger = ?');
$sth->bind_param(1, lc $channel);
@ -260,8 +238,7 @@ sub get_trigger {
return $target;
}
sub cmd_counteradd {
my ($self, $context) = @_;
sub cmd_counteradd($self, $context) {
return "Internal error." if not $self->dbi_begin;
my ($channel, $name, $description);
@ -273,24 +250,31 @@ sub cmd_counteradd {
} else {
$channel = $context->{from};
($name, $description) = split /\s+/, $context->{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($context->{hostmask}, $channel, $name, $description)) { $result = "Counter added."; }
else { $result = "Counter '$name' already exists."; }
if ($self->add_counter($context->{hostmask}, $channel, $name, $description)) {
$result = "Counter added.";
} else {
$result = "Counter '$name' already exists.";
}
$self->dbi_end;
return $result;
}
sub cmd_counterdel {
my ($self, $context) = @_;
sub cmd_counterdel($self, $context) {
return "Internal error." if not $self->dbi_begin;
my ($channel, $name);
if ($context->{from} !~ m/^#/) {
($channel, $name) = split /\s+/, $context->{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 = $context->{from};
($name) = split /\s+/, $context->{arguments}, 1;
@ -298,20 +282,25 @@ sub cmd_counterdel {
}
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;
}
sub cmd_counterreset {
my ($self, $context) = @_;
sub cmd_counterreset($self, $context) {
return "Internal error." if not $self->dbi_begin;
my ($channel, $name);
if ($context->{from} !~ m/^#/) {
($channel, $name) = split /\s+/, $context->{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 = $context->{from};
($name) = split /\s+/, $context->{arguments}, 1;
@ -331,14 +320,15 @@ sub cmd_counterreset {
return $result;
}
sub cmd_countershow {
my ($self, $context) = @_;
sub cmd_countershow($self, $context) {
return "Internal error." if not $self->dbi_begin;
my ($channel, $name);
if ($context->{from} !~ m/^#/) {
($channel, $name) = split /\s+/, $context->{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 = $context->{from};
($name) = split /\s+/, $context->{arguments}, 1;
@ -359,13 +349,15 @@ sub cmd_countershow {
return $result;
}
sub cmd_counterlist {
my ($self, $context) = @_;
sub cmd_counterlist($self, $context) {
return "Internal error." if not $self->dbi_begin;
my $channel;
if ($context->{from} !~ m/^#/) {
if (not length $context->{arguments} or $context->{arguments} !~ m/^#/) { return "Usage from private message: counterlist <channel>"; }
if (not length $context->{arguments} or $context->{arguments} !~ m/^#/) {
return "Usage from private message: counterlist <channel>";
}
$channel = $context->{arguments};
} else {
$channel = $context->{from};
@ -388,8 +380,7 @@ sub cmd_counterlist {
return $result;
}
sub cmd_countertrigger {
my ($self, $context) = @_;
sub cmd_countertrigger($self, $context) {
return "Internal error." if not $self->dbi_begin;
my $command;
($command, $context->{arguments}) = split / /, $context->{arguments}, 2;
@ -398,9 +389,11 @@ sub cmd_countertrigger {
given ($command) {
when ('list') {
if ($context->{from} =~ m/^#/) { $channel = $context->{from}; }
else {
if ($context->{from} =~ m/^#/) {
$channel = $context->{from};
} else {
($channel) = split / /, $context->{arguments}, 1;
if ($channel !~ m/^#/) {
$self->dbi_end;
return "Usage from private message: countertrigger list <channel>";
@ -433,8 +426,12 @@ sub cmd_countertrigger {
my ($trigger, $target) = split / /, $context->{arguments}, 2;
if (not defined $trigger or not defined $target) {
if ($context->{from} !~ m/^#/) { $result = "Usage from private message: countertrigger add <channel> <regex> <target>"; }
else { $result = "Usage: countertrigger add <regex> <target>"; }
if ($context->{from} !~ m/^#/) {
$result = "Usage from private message: countertrigger add <channel> <regex> <target>";
} else {
$result = "Usage: countertrigger add <regex> <target>";
}
$self->dbi_end;
return $result;
}
@ -446,8 +443,11 @@ sub cmd_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') {
@ -485,8 +485,7 @@ sub cmd_countertrigger {
return $result;
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
my $channel = $event->{to}[0];
@ -506,8 +505,11 @@ 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;
@ -527,6 +529,7 @@ sub on_public {
if ($@) { $self->{pbot}->{logger}->log("Skipping bad trigger $trigger->{trigger}: $@"); }
}
$self->dbi_end;
return 0;
}

11
lib/PBot/Plugin/Date.pm
View File

@ -10,9 +10,7 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# add default registry entry for default timezone
# this can be overridden via arguments or user metadata
$self->{pbot}->{registry}->add_default('text', 'date', 'default_timezone', 'UTC');
@ -25,14 +23,11 @@ sub initialize {
);
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->remove('date');
}
sub cmd_date {
my ($self, $context) = @_;
sub cmd_date($self, $context) {
my $usage = "Usage: date [-u <user account>] [timezone]";
my %opts;

11
lib/PBot/Plugin/Example.pm
View File

@ -10,24 +10,19 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{event_dispatcher}->register_handler(
'irc.public',
sub { $self->on_public(@_) },
);
}
sub unload {
my $self = shift;
sub unload($self) {
# perform plugin clean-up here
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = (
$event->nick,
$event->user,

46
lib/PBot/Plugin/FuncBuiltins.pm
View File

@ -15,8 +15,7 @@ use PBot::Core::Utils::Indefinite;
use Lingua::EN::Tagger;
use URI::Escape qw/uri_escape_utf8/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{functions}->register(
'title',
{
@ -85,8 +84,7 @@ sub initialize {
$self->{tagger} = Lingua::EN::Tagger->new;
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{functions}->unregister('title');
$self->{pbot}->{functions}->unregister('ucfirst');
$self->{pbot}->{functions}->unregister('uc');
@ -97,26 +95,23 @@ sub unload {
$self->{pbot}->{functions}->unregister('maybe-the');
}
sub func_unquote {
my $self = shift;
my $text = "@_";
sub func_unquote($self, @rest) {
my $text = "@rest";
$text =~ s/^"(.*?)(?<!\\)"$/$1/ || $text =~ s/^'(.*?)(?<!\\)'$/$1/;
$text =~ s/(?<!\\)\\'/'/g;
$text =~ s/(?<!\\)\\"/"/g;
return $text;
}
sub func_title {
my $self = shift;
my $text = "@_";
sub func_title($self, @rest) {
my $text = "@rest";
$text = ucfirst lc $text;
$text =~ s/ (\w)/' ' . uc $1/ge;
return $text;
}
sub func_ucfirst {
my $self = shift;
my $text = "@_";
sub func_ucfirst($self, @rest) {
my $text = "@rest";
my ($word) = $text =~ m/^\s*([^',.;: ]+)/;
@ -128,27 +123,23 @@ sub func_ucfirst {
return ucfirst $text;
}
sub func_uc {
my $self = shift;
my $text = "@_";
sub func_uc($self, @rest) {
my $text = "@rest";
return uc $text;
}
sub func_lc {
my $self = shift;
my $text = "@_";
sub func_lc($self, @rest) {
my $text = "@rest";
return lc $text;
}
sub func_uri_escape {
my $self = shift;
my $text = "@_";
sub func_uri_escape($self, @rest) {
my $text = "@rest";
return uri_escape_utf8($text);
}
sub func_ana {
my $self = shift;
my $text = "@_";
sub func_ana($self, @rest) {
my $text = "@rest";
if ($text =~ s/\b(an?)(\s+)//i) {
my ($article, $spaces) = ($1, $2);
@ -166,9 +157,8 @@ sub func_ana {
return $text;
}
sub func_maybe_the {
my $self = shift;
my $text = "@_";
sub func_maybe_the($self, @rest) {
my $text = "@rest";
my ($word) = $text =~ m/^\s*([^',.;: ]+)/;

12
lib/PBot/Plugin/FuncGrep.pm
View File

@ -10,8 +10,7 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{functions}->register(
'grep',
{
@ -22,15 +21,12 @@ sub initialize {
);
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{functions}->unregister('grep');
}
sub func_grep {
my $self = shift @_;
my $regex = shift @_;
my $text = "@_";
sub func_grep($self, $regex, @rest) {
my $text = "@rest";
my $result = eval {
my $result = '';

11
lib/PBot/Plugin/FuncSed.pm
View File

@ -10,8 +10,7 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{functions}->register(
'sed',
{
@ -22,16 +21,14 @@ sub initialize {
);
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{functions}->unregister('sed');
}
# near-verbatim insertion of krok's `sed` factoid
no warnings;
sub func_sed {
my $self = shift;
my $text = "@_";
sub func_sed($self, @rest) {
my $text = "@rest";
my $result = eval {
if ($text =~ /^s(.)(.*?)(?<!\\)\1(.*?)(?<!\\)\1(\S*)\s+(.*)/p) {

13
lib/PBot/Plugin/GetUrl.pm
View File

@ -4,7 +4,7 @@
#
# TODO: add --useragent and --striphtml, etc, options
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::GetUrl;
@ -14,23 +14,18 @@ use PBot::Imports;
use LWP::UserAgent::Paranoid;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{registry}->add_default('text', 'geturl', 'enabled', 1);
$self->{pbot}->{registry}->add_default('text', 'geturl', 'max_size', 1024 * 1024);
$self->{pbot}->{commands}->register(sub { $self->cmd_geturl(@_) }, 'geturl', 0);
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{commands}->unregister('geturl');
}
sub cmd_geturl {
my ($self, $context) = @_;
sub cmd_geturl($self, $context) {
return "Usage: geturl <url>\n" if not length $context->{arguments};
my $enabled = $self->{pbot}->{registry}->get_value('geturl', 'enabled');

9
lib/PBot/Plugin/ParseDate.pm
View File

@ -13,8 +13,7 @@ use PBot::Imports;
use Time::Duration qw/duration/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'pd',
help => 'Simple command to test ParseDate interface',
@ -22,13 +21,11 @@ sub initialize {
);
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->remove('pd');
}
sub cmd_parsedate {
my ($self, $context) = @_;
sub cmd_parsedate($self, $context) {
my ($seconds, $error) = $self->{pbot}->{parsedate}->parsedate($context->{arguments});
return $error if defined $error;
return duration $seconds;

33
lib/PBot/Plugin/Plang.pm
View File

@ -11,9 +11,7 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# load Plang module
my $path = $self->{pbot}->{registry}->get_value('general', 'plang_dir') // 'Plang';
unshift @INC, "$path/lib" if not grep { $_ eq "$path/lib" } @INC;
@ -89,16 +87,13 @@ sub initialize {
}
# runs when plugin is unloaded
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->unregister('plang');
$self->{pbot}->{commands}->unregister('plangrepl');
delete $INC{"Plang/Interpreter.pm"};
}
sub cmd_plang {
my ($self, $context) = @_;
sub cmd_plang($self, $context) {
my $usage = "Usage: plang <code>; see https://github.com/pragma-/Plang and https://github.com/pragma-/pbot/blob/master/doc/Plugins/Plang.md";
return $usage if not length $context->{arguments};
@ -121,9 +116,7 @@ sub cmd_plang {
return length $self->{output} ? $self->{output} : "No output.";
}
sub cmd_plangrepl {
my ($self, $context) = @_;
sub cmd_plangrepl($self, $context) {
my $usage = "Usage: plangrepl <code>; see https://github.com/pragma-/Plang and https://github.com/pragma-/pbot/blob/master/doc/Plugins/Plang.md";
return $usage if not length $context->{arguments};
@ -146,8 +139,7 @@ sub cmd_plangrepl {
}
# overridden `print` built-in
sub plang_builtin_print {
my ($self, $plang, $context, $name, $arguments) = @_;
sub plang_builtin_print($self, $plang, $context, $name, $arguments) {
my ($expr, $end) = ($plang->output_value($arguments->[0]), $arguments->[1]->[1]);
$self->{output} .= "$expr$end";
return [['TYPE', 'Null'], undef];
@ -159,13 +151,11 @@ sub plang_validate_builtin_print {
# our custom PBot built-in functions for Plang
sub is_locked {
my ($self, $channel, $keyword) = @_;
sub is_locked($self, $channel, $keyword) {
return $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, 'locked');
}
sub plang_builtin_factget {
my ($self, $plang, $context, $name, $arguments) = @_;
sub plang_builtin_factget($self, $plang, $context, $name, $arguments) {
my ($channel, $keyword, $meta) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]);
my $result = $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, $meta);
if (defined $result) {
@ -179,8 +169,7 @@ sub plang_validate_builtin_factget {
return [['TYPE', 'String'], ""];
}
sub plang_builtin_factset {
my ($self, $plang, $context, $name, $arguments) = @_;
sub plang_builtin_factset($self, $plang, $context, $name, $arguments) {
my ($channel, $keyword, $text) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]);
die "Factoid $channel.$keyword is locked. Cannot set.\n" if $self->is_locked($channel, $keyword);
$self->{pbot}->{factoids}->{data}->add('text', $channel, 'Plang', $keyword, $text);
@ -191,8 +180,7 @@ sub plang_validate_builtin_factset {
return [['TYPE', 'String'], ""];
}
sub plang_builtin_factappend {
my ($self, $plang, $context, $name, $arguments) = @_;
sub plang_builtin_factappend($self, $plang, $context, $name, $arguments) {
my ($channel, $keyword, $text) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]);
die "Factoid $channel.$keyword is locked. Cannot append.\n" if $self->is_locked($channel, $keyword);
my $action = $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, 'action');
@ -206,8 +194,7 @@ sub plang_validate_builtin_factappend {
return [['TYPE', 'String'], ""];
}
sub plang_builtin_userget {
my ($self, $plang, $context, $name, $arguments) = @_;
sub plang_builtin_userget($self, $plang, $context, $name, $arguments) {
my ($username) = ($arguments->[0], $arguments->[1]);
my $user = $self->{pbot}->{users}->{storage}->get_data($username->[1]);

26
lib/PBot/Plugin/Quotegrabs.pm
View File

@ -23,8 +23,7 @@ use PBot::Core::Utils::ValidateString;
use POSIX qw(strftime);
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{filename} = $conf{quotegrabs_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.sqlite3';
$self->{database} = PBot::Plugin::Quotegrabs::Storage::SQLite->new(pbot => $self->{pbot}, filename => $self->{filename});
@ -39,8 +38,7 @@ sub initialize {
$self->{pbot}->{commands}->register(sub { $self->cmd_show_random_quotegrab(@_) }, 'rq' );
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{commands}->unregister('grab');
$self->{pbot}->{commands}->unregister('getq');
$self->{pbot}->{commands}->unregister('delq');
@ -50,9 +48,7 @@ sub unload {
sub uniq { my %seen; grep !$seen{$_}++, @_ }
sub export_quotegrabs {
my $self = shift;
sub export_quotegrabs($self) {
$self->{export_path} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.html';
my $quotegrabs = $self->{database}->get_all_quotegrabs;
@ -153,9 +149,7 @@ sub export_quotegrabs {
return "$i quotegrabs exported.";
}
sub cmd_grab_quotegrab {
my ($self, $context) = @_;
sub cmd_grab_quotegrab($self, $context) {
if (not length $context->{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";
@ -264,9 +258,7 @@ sub cmd_grab_quotegrab {
}
}
sub cmd_delete_quotegrab {
my ($self, $context) = @_;
sub cmd_delete_quotegrab($self, $context) {
my $quotegrab = $self->{database}->get_quotegrab($context->{arguments});
if (not defined $quotegrab) {
@ -293,9 +285,7 @@ sub cmd_delete_quotegrab {
}
}
sub cmd_show_quotegrab {
my ($self, $context) = @_;
sub cmd_show_quotegrab($self, $context) {
my $quotegrab = $self->{database}->get_quotegrab($context->{arguments});
if (not defined $quotegrab) {
@ -316,9 +306,7 @@ sub cmd_show_quotegrab {
}
}
sub cmd_show_random_quotegrab {
my ($self, $context) = @_;
sub cmd_show_random_quotegrab($self, $context) {
my $usage = 'Usage: rq [nick [channel [text]]] [-c <channel>] [-t <text>]';
my ($nick_search, $channel_search, $text_search);

46
lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm
View File

@ -1,8 +1,13 @@
# File: Hashtable.pm
#
# Purpose: Hashtable backend for storing and retreiving quotegrabs.
#
# Note: This has not been maintained since the SQLite backend was created. It
# is strongly recommended to use the SQLite backend instead since it contains
# several improvements such as shuffling through random quotegrabs without
# repeats, etc.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::Quotegrabs::Storage::Hashtable;
@ -16,31 +21,22 @@ 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"); }
my ($class, %conf) = @_;
sub new($class, %conf) {
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference in " . __FILE__);
$self->{filename} = delete $conf{filename};
$self->{quotegrabs} = [];
}
sub begin {
my $self = shift;
sub begin($self) {
$self->load_quotegrabs;
}
sub end { }
sub load_quotegrabs {
my $self = shift;
my $filename;
@ -96,37 +92,30 @@ sub save_quotegrabs {
close(FILE);
}
sub add_quotegrab {
my ($self, $quotegrab) = @_;
sub add_quotegrab($self, $quotegrab) {
push @{$self->{quotegrabs}}, $quotegrab;
$self->save_quotegrabs();
return $#{$self->{quotegrabs}} + 1;
}
sub delete_quotegrab {
my ($self, $id) = @_;
sub delete_quotegrab($self, $id) {
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();
}
sub get_quotegrab {
my ($self, $id) = @_;
sub get_quotegrab($self, $id) {
if ($id < 1 || $id > $#{$self->{quotegrabs}} + 1) { return undef; }
return $self->{quotegrabs}[$id - 1];
}
sub get_random_quotegrab {
my ($self, $nick, $channel, $text) = @_;
sub get_random_quotegrab($self, $nick, $channel, $text) {
$nick = '.*' if not defined $nick;
$channel = '.*' if not defined $channel;
$text = '.*' if not defined $text;
@ -153,8 +142,7 @@ sub get_random_quotegrab {
return $quotes[int rand($#quotes + 1)];
}
sub get_all_quotegrabs {
my $self = shift;
sub get_all_quotegrabs($self) {
return $self->{quotegrabs};
}

12
lib/PBot/Plugin/RelayUnreg.pm
View File

@ -16,22 +16,19 @@ use PBot::Imports;
use Time::HiRes qw/gettimeofday/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
$self->{queue} = [];
$self->{notified} = {};
$self->{pbot}->{event_queue}->enqueue(sub { $self->check_queue }, 1, 'RelayUnreg');
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{event_queue}->dequeue('RelayUnreg');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
my $channel = lc $event->{to}[0];
@ -90,8 +87,7 @@ sub on_public {
return 0;
}
sub check_queue {
my $self = shift;
sub check_queue($self) {
my $now = gettimeofday;
if (@{$self->{queue}}) {

39
lib/PBot/Plugin/RestrictedMod.pm
View File

@ -16,9 +16,7 @@ use PBot::Imports;
use Storable qw/dclone/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'mod',
help => 'Provides restricted moderation abilities to voiced users. They can kick/ban/etc only users that are not admins, whitelisted, voiced or opped.',
@ -41,14 +39,12 @@ sub initialize {
};
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{commands}->remove('mod');
$self->{pbot}->{capabilities}->remove('chanmod');
}
sub help {
my ($self, $context) = @_;
sub help($self, $context) {
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // 'help';
if (exists $self->{commands}->{$command}) {
@ -58,14 +54,11 @@ sub help {
}
}
sub list {
my ($self, $context) = @_;
sub list($self, $context) {
return "Available mod commands: " . join ', ', sort keys %{$self->{commands}};
}
sub generic_command {
my ($self, $context, $command) = @_;
sub generic_command($self, $context, $command) {
my $channel = $context->{from};
if ($channel !~ m/^#/) {
$channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
@ -147,41 +140,33 @@ sub generic_command {
return "";
}
sub kick {
my ($self, $context) = @_;
sub kick($self, $context) {
return $self->generic_command($context, 'kick');
}
sub ban {
my ($self, $context) = @_;
sub ban($self, $context) {
return $self->generic_command($context, 'ban');
}
sub mute {
my ($self, $context) = @_;
sub mute($self, $context) {
return $self->generic_command($context, 'mute');
}
sub unban {
my ($self, $context) = @_;
sub unban($self, $context) {
return $self->generic_command($context, 'unban');
}
sub unmute {
my ($self, $context) = @_;
sub unmute($self, $context) {
return $self->generic_command($context, 'unmute');
}
sub kb {
my ($self, $context) = @_;
sub kb($self, $context) {
my $result = $self->ban(dclone $context); # note: using copy of $context to preserve $context->{arglist} for $self->kick($context)
return $result if length $result;
return $self->kick($context);
}
sub cmd_mod {
my ($self, $context) = @_;
sub cmd_mod($self, $context) {
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // '';
$command = lc $command;

17
lib/PBot/Plugin/RunCommand.pm
View File

@ -17,7 +17,7 @@
#
# This plugin is not in data/plugin_autoload. Load at your own risk.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::RunCommand;
@ -27,9 +27,7 @@ use PBot::Imports;
use IPC::Run qw/start pump finish/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'runcmd',
help => 'Executes a system command and outputs each line in real-time',
@ -38,14 +36,11 @@ sub initialize {
);
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->remove('runcmd');
}
sub cmd_runcmd {
my ($self, $context) = @_;
sub cmd_runcmd($self, $context) {
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
my ($in, $out, $err);
@ -71,9 +66,7 @@ sub cmd_runcmd {
return "No output." if not $lines;
}
sub send_lines {
my ($self, $context, $buffer, $send_all) = @_;
sub send_lines($self, $context, $buffer, $send_all) {
my $lines = 0;
my $regex;

489
lib/PBot/Plugin/Spinach.pm
View File

File diff suppressed because it is too large Load Diff

42
lib/PBot/Plugin/Spinach/Rank.pm
View File

@ -2,7 +2,7 @@
#
# Purpose: Ranks players by various keywords.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::Spinach::Rank;
@ -15,56 +15,47 @@ use lib "$FindBin::RealBin/../../..";
use PBot::Plugin::Spinach::Stats;
use Math::Expression::Evaluator;
sub new {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref $_[1] eq 'HASH';
my ($class, %conf) = @_;
sub new($class, %conf) {
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
$self->{channel} = $conf{channel} // Carp::croak("Missing channel reference to " . __FILE__);
$self->{filename} = $conf{filename} // 'stats.sqlite';
$self->{stats} = PBot::Plugin::Spinach::Stats->new(pbot => $self->{pbot}, filename => $self->{filename});
}
sub sort_generic {
my ($self, $key) = @_;
sub sort_generic($self, $key) {
if ($self->{rank_direction} eq '+') { return $b->{$key} <=> $a->{$key}; }
else { return $a->{$key} <=> $b->{$key}; }
}
sub print_generic {
my ($self, $key, $player) = @_;
sub print_generic($self, $key, $player) {
return undef if $player->{games_played} == 0;
return "$player->{nick}: $player->{$key}";
}
sub print_avg_score {
my ($self, $player) = @_;
sub print_avg_score($self, $player) {
return undef if $player->{games_played} == 0;
my $result = int $player->{avg_score};
return "$player->{nick}: $result";
}
sub sort_bad_lies {
my ($self) = @_;
sub sort_bad_lies($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}; }
}
sub print_bad_lies {
my ($self, $player) = @_;
sub print_bad_lies($self, $player) {
return undef if $player->{games_played} == 0;
my $result = $player->{questions_played} - $player->{good_lies};
return "$player->{nick}: $result";
}
sub sort_mentions {
my ($self) = @_;
sub sort_mentions($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};
@ -74,16 +65,13 @@ sub sort_mentions {
}
}
sub print_mentions {
my ($self, $player) = @_;
sub print_mentions($self, $player) {
return undef if $player->{games_played} == 0;
my $result = $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third};
return "$player->{nick}: $result";
}
sub sort_expr {
my ($self) = @_;
sub sort_expr($self) {
my $result = eval {
my $result_a = $self->{expr}->val(
{
@ -135,9 +123,7 @@ sub sort_expr {
return $result;
}
sub print_expr {
my ($self, $player) = @_;
sub print_expr($self, $player) {
return undef if $player->{games_played} == 0;
my $result = eval {
@ -169,9 +155,7 @@ sub print_expr {
return "$player->{nick}: $result";
}
sub rank {
my ($self, $arguments) = @_;
sub rank($self, $arguments) {
my %ranks = (
highscore => {
sort => sub { $self->sort_generic('high_score', @_) },

36
lib/PBot/Plugin/Spinach/Stats.pm
View File

@ -2,7 +2,7 @@
#
# Purpose: Records player stats.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::Spinach::Stats;
@ -12,22 +12,18 @@ use PBot::Imports;
use DBI;
use Carp qw(shortmess);
sub new {
my ($class, %conf) = @_;
sub new($class, %conf) {
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
$self->{filename} = $conf{filename} // 'stats.sqlite';
}
sub begin {
my $self = shift;
sub begin($self) {
$self->{pbot}->{logger}->log("Opening Spinach stats SQLite database: $self->{filename}\n");
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0}) or die $DBI::errstr;
@ -57,9 +53,7 @@ SQL
$self->{pbot}->{logger}->log("Error creating database: $@\n") if $@;
}
sub end {
my $self = shift;
sub end($self) {
if (exists $self->{dbh} and defined $self->{dbh}) {
$self->{pbot}->{logger}->log("Closing stats SQLite database\n");
$self->{dbh}->disconnect();
@ -67,9 +61,7 @@ sub end {
}
}
sub add_player {
my ($self, $id, $nick, $channel) = @_;
sub add_player($self, $id, $nick, $channel) {
eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Stats (id, nick, channel) VALUES (?, ?, ?)');
$sth->execute($id, $nick, $channel);
@ -83,9 +75,7 @@ sub add_player {
return $id;
}
sub get_player_id {
my ($self, $nick, $channel, $dont_create_new) = @_;
sub get_player_id($self, $nick, $channel, $dont_create_new) {
my ($account_id) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($nick);
$account_id = $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($account_id);
@ -107,9 +97,7 @@ sub get_player_id {
return $id;
}
sub get_player_data {
my ($self, $id, @columns) = @_;
sub get_player_data($self, $id, @columns) {
return undef if not $id;
my $player_data = eval {
@ -133,9 +121,7 @@ sub get_player_data {
return $player_data;
}
sub update_player_data {
my ($self, $id, $data) = @_;
sub update_player_data($self, $id, $data) {
eval {
my $sql = 'UPDATE Stats SET ';
@ -158,9 +144,7 @@ sub update_player_data {
print STDERR $@ if $@;
}
sub get_all_players {
my ($self, $channel) = @_;
sub get_all_players($self, $channel) {
my $players = eval {
my $sth = $self->{dbh}->prepare('SELECT * FROM Stats WHERE channel = ?');
$sth->execute($channel);

10
lib/PBot/Plugin/TypoSub.pm
View File

@ -20,21 +20,17 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_public(@_) });
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
}
sub on_public {
my ($self, $event_type, $event) = @_;
sub on_public($self, $event_type, $event) {
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
my $channel = lc $event->{to}[0];

30
lib/PBot/Plugin/UrlTitles.pm
View File

@ -21,9 +21,7 @@ use constant {
MAX_SIZE => 1024 * 800,
};
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# remember recent titles so we don't repeat them too often
my $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/url-title.hist';
@ -43,15 +41,12 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->show_url_titles(@_) });
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
}
sub is_ignored_url {
my ($self, $url) = @_;
sub is_ignored_url($self, $url) {
return 1 if $url =~ m{https://asciinema.org}i;
return 1 if $url =~ m{https?://tpcg.io/}i;
return 1 if $url =~ m/bootlin.com/i;
@ -79,7 +74,7 @@ sub is_ignored_url {
return 1 if $url =~ m{godbolt.org}i;
return 1 if $url =~ m{man\.cgi}i;
return 1 if $url =~ m{wandbox}i;
return 1 if $url =~ m{ebay.com/itm}i;
#return 1 if $url =~ m{ebay.com/itm}i;
return 1 if $url =~ m/prntscr.com/i;
return 1 if $url =~ m/imgbin.org/i;
return 1 if $url =~ m/jsfiddle.net/i;
@ -120,9 +115,8 @@ sub is_ignored_url {
return 0;
}
sub is_ignored_title {
my ($self, $title) = @_;
sub is_ignored_title($self, $title) {
return 1 if $title =~ m{reddit - dive into anything}i;
return 1 if $title =~ m{dive into reddit}i;
return 1 if $title =~ m{^Loading}i;
return 1 if $title =~ m{streamable}i;
@ -146,9 +140,7 @@ sub is_ignored_title {
return 0;
}
sub get_title {
my ($self, $context) = @_;
sub get_title($self, $context) {
my $url = $context->{arguments};
my $ua = LWP::UserAgent::Paranoid->new(request_timeout => TIMEOUT);
@ -218,9 +210,7 @@ sub get_title {
$context->{url} = $url;
}
sub title_pipe_reader {
my ($self, $pid, $buf) = @_;
sub title_pipe_reader($self, $pid, $buf) {
# retrieve context object from child
my $context = decode_json $buf or do {
$self->{pbot}->{logger}->log("Failed to decode bad json: [$buf]\n");
@ -260,9 +250,7 @@ sub title_pipe_reader {
$self->{pbot}->{interpreter}->handle_result($context);
}
sub show_url_titles {
my ($self, $event_type, $event) = @_;
sub show_url_titles($self, $event_type, $event) {
my ($nick, $user, $host) = (
$event->nick,
$event->user,

18
lib/PBot/Plugin/Weather.pm
View File

@ -13,9 +13,7 @@ use PBot::Imports;
use PBot::Core::Utils::LWPUserAgentCached;
use XML::LibXML;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'weather',
help => 'Provides weather service via AccuWeather',
@ -23,14 +21,11 @@ sub initialize {
);
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->remove('weather');
}
sub cmd_weather {
my ($self, $context) = @_;
sub cmd_weather($self, $context) {
my $usage = "Usage: weather (<location> | -u <user account>)";
my $arguments = $context->{arguments};
@ -67,9 +62,7 @@ sub cmd_weather {
return $self->get_weather($arguments);
}
sub get_weather {
my ($self, $location) = @_;
sub get_weather($self, $location) {
my %cache_opt = (
'namespace' => 'accuweather',
'default_expires_in' => 3600
@ -119,8 +112,7 @@ sub get_weather {
return $result;
}
sub fix_temps {
my ($self, $text) = @_;
sub fix_temps($self, $text) {
$text =~ s|(-?\d+)\s*F|my $f = $1; my $c = ($f - 32 ) * 5 / 9; $c = sprintf("%.1d", $c); "${c}C/${f}F"|eg;
return $text;
}

13
lib/PBot/Plugin/Wolfram.pm
View File

@ -2,7 +2,7 @@
#
# Purpose: Query Wolfram|Alpha's Short Answers API.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::Wolfram;
@ -13,9 +13,7 @@ use PBot::Imports;
use LWP::UserAgent::Paranoid;
use URI::Escape qw/uri_escape_utf8/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
# add default registry entry for `wolfram.appid`
$self->{pbot}->{registry}->add_default('text', 'wolfram', 'appid', '');
@ -30,14 +28,11 @@ sub initialize {
);
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{commands}->remove('wolfram');
}
sub cmd_wolfram {
my ($self, $context) = @_;
sub cmd_wolfram($self, $context) {
return "Usage: wolfram <query>\n" if not length $context->{arguments};
my $appid = $self->{pbot}->{registry}->get_value('wolfram', 'appid');

51
lib/PBot/Plugin/WordMorph.pm
View File

@ -3,7 +3,7 @@
# Purpose: Word morph game. Solve a path between two words by changing one
# letter at a time. love > shot = love > lose > lost > loot > soot > shot.
# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com>
# SPDX-FileCopyrightText: 2022-2023 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::WordMorph;
@ -14,9 +14,7 @@ use PBot::Imports;
use Storable;
use Text::Levenshtein::XS 'distance';
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'wordmorph',
help => 'Word Morph game! Solve a path between two words by changing one letter at a time: love > shot = love > lose > lost > loot > soot > shot.',
@ -29,8 +27,7 @@ sub initialize {
or $self->{pbot}->{logger}->log($@);
}
sub unload {
my ($self) = @_;
sub unload($self) {
$self->{pbot}->{commands}->remove('wordmorph');
}
@ -47,9 +44,7 @@ use constant {
MAX_WORD_LENGTH => 7,
};
sub wordmorph {
my ($self, $context) = @_;
sub wordmorph($self, $context) {
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments});
my $command = shift @args;
@ -303,9 +298,7 @@ sub wordmorph {
}
}
sub load_db {
my ($self) = @_;
sub load_db($self) {
if (not -e $self->{db_path}) {
die "Word morph database not available; run `/misc/wordmorph/wordmorph-mkdb` to create it.\n";
}
@ -313,9 +306,7 @@ sub load_db {
return retrieve($self->{db_path});
}
sub show_morph_with_blanks {
my ($self, $channel) = @_;
sub show_morph_with_blanks($self, $channel) {
my @middle;
for (1 .. @{$self->{$channel}->{morph}} - 2) {
push @middle, '_' x length $self->{$channel}->{word1};
@ -324,8 +315,7 @@ sub show_morph_with_blanks {
return "$self->{$channel}->{word1} > " . join(' > ', @middle) . " > $self->{$channel}->{word2}";
}
sub set_up_new_morph {
my ($self, $morph, $channel) = @_;
sub set_up_new_morph($self, $morph, $channel) {
$self->{$channel}->{morph} = $morph;
$self->{$channel}->{word1} = $morph->[0];
$self->{$channel}->{word2} = $morph->[$#$morph];
@ -333,9 +323,7 @@ sub set_up_new_morph {
$self->{$channel}->{hintR} = $#$morph - 1;
}
sub form_hint {
my ($word1, $word2) = @_;
sub form_hint($word1, $word2) {
my $hint = '';
for (0 .. length $word1) {
@ -349,9 +337,7 @@ sub form_hint {
return $hint;
}
sub validate_word {
my ($self, $word, $min, $max) = @_;
sub validate_word($self, $word, $min, $max) {
my $len = length $word;
if ($len < $min) {
@ -367,9 +353,7 @@ sub validate_word {
return undef;
}
sub compare_suffix {
my ($word1, $word2) = @_;
sub compare_suffix($word1, $word2) {
my $length = 0;
for (my $i = length($word1) - 1; $i >= 0; --$i) {
@ -383,9 +367,7 @@ sub compare_suffix {
return $length;
}
sub make_morph_by_steps {
my ($self, $db, $steps, $length) = @_;
sub make_morph_by_steps($self, $db, $steps, $length) {
$length //= int(rand(3)) + 5;
my @words = keys %{$db->{$length}};
@ -428,17 +410,14 @@ sub make_morph_by_steps {
# the following subs are based on https://www.perlmonks.org/?node_id=558123
sub makemorph {
my ($db, $left, $right) = @_;
sub makemorph($db, $left, $right) {
die "The length of given words are not equal.\n" if length($left) != length($right);
my $list = $db->{length $left};
my $morph = eval { [transform(lc $left, lc $right, $list)] } or die $@;
return $morph;
}
sub transform {
my ($left, $right, $list) = @_;
sub transform($left, $right, $list) {
my (@left, %left, @right, %right); # @left and @right- arrays containing word relation trees: ([foo], [0, foe], [0, fou], [0, 1, fie] ...)
# %left and %right - indices containing word offsets in arrays @left and @right
@ -502,9 +481,7 @@ sub transform {
return @path;
}
sub print_rel {
my ($id, $ary) = @_;
sub print_rel($id, $ary) {
my @rel = @{$ary->[$id]};
my @line;

15
lib/PBot/Plugin/Wttr.pm
View File

@ -14,9 +14,7 @@ use PBot::Core::Utils::LWPUserAgentCached;
use JSON;
use URI::Escape qw/uri_escape_utf8/;
sub initialize {
my ($self, %conf) = @_;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'wttr',
help => 'Provides weather information via wttr.in',
@ -24,14 +22,11 @@ sub initialize {
);
}
sub unload {
my $self = shift;
sub unload($self) {
$self->{pbot}->{commands}->remove('wttr');
}
sub cmd_wttr {
my ($self, $context) = @_;
sub cmd_wttr($self, $context) {
my $arguments = $context->{arguments};
my @wttr_options = (
@ -104,9 +99,7 @@ sub cmd_wttr {
return $self->get_wttr($arguments, \@opts, \@wttr_options);
}
sub get_wttr {
my ($self, $location, $options, $order) = @_;
sub get_wttr($self, $location, $options, $order) {
my %cache_opt = (
'namespace' => 'wttr',
'default_expires_in' => 900

2
lib/PBot/VERSION.pm
View File

@ -25,7 +25,7 @@ use PBot::Imports;
# These are set by the /misc/update_version script
use constant {
BUILD_NAME => "PBot",
BUILD_REVISION => 4645,
BUILD_REVISION => 4646,
BUILD_DATE => "2023-04-13",
};