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

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

@ -13,8 +13,7 @@ use PBot::Imports;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
use Time::Duration; use Time::Duration;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{registry}->add_default('array', 'antikickautorejoin', 'punishment', '30,90,180,300,28800'); $self->{pbot}->{registry}->add_default('array', 'antikickautorejoin', 'punishment', '30,90,180,300,28800');
$self->{pbot}->{registry}->add_default('text', 'antikickautorejoin', 'threshold', '2'); $self->{pbot}->{registry}->add_default('text', 'antikickautorejoin', 'threshold', '2');
@ -23,14 +22,12 @@ sub initialize {
$self->{kicks} = {}; $self->{kicks} = {};
} }
sub unload { sub unload($self) {
my ($self) = @_;
$self->{pbot}->{event_dispatcher}->remove_handler('irc.kick'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.kick');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.join'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.join');
} }
sub on_kick { sub on_kick($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host); my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
my ($target, $channel, $reason) = ($event->to, $event->{args}[0], $event->{args}[1]); my ($target, $channel, $reason) = ($event->to, $event->{args}[0], $event->{args}[1]);
@ -46,8 +43,7 @@ sub on_kick {
return 0; return 0;
} }
sub on_join { sub on_join($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to); my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
$channel = lc $channel; $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::Duration qw/duration/;
use Time::HiRes qw/gettimeofday/; use Time::HiRes qw/gettimeofday/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) }); $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->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action(@_) });
$self->{nicks} = {}; $self->{nicks} = {};
} }
sub unload { sub unload($self) {
my ($self) = @_;
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
} }
sub on_action { sub on_action($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args); my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
my $channel = $event->{to}[0]; my $channel = $event->{to}[0];
return 0 if $event->{interpreted}; return 0 if $event->{interpreted};
@ -36,8 +33,7 @@ sub on_action {
return 0; return 0;
} }
sub on_public { sub on_public($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args); my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
my $channel = $event->{to}[0]; my $channel = $event->{to}[0];
return 0 if $event->{interpreted}; return 0 if $event->{interpreted};
@ -45,8 +41,7 @@ sub on_public {
return 0; return 0;
} }
sub check_flood { sub check_flood($self, $nick, $user, $host, $channel, $msg) {
my ($self, $nick, $user, $host, $channel, $msg) = @_;
return 0 if not $self->{pbot}->{chanops}->can_gain_ops($channel); return 0 if not $self->{pbot}->{chanops}->can_gain_ops($channel);
$channel = lc $channel; $channel = lc $channel;
@ -76,10 +71,9 @@ sub check_flood {
} }
} }
sub clear_old_nicks { sub clear_old_nicks($self, $channel) {
my ($self, $channel) = @_;
my $now = gettimeofday;
return if not exists $self->{nicks}->{$channel}; return if not exists $self->{nicks}->{$channel};
my $now = gettimeofday;
while (1) { while (1) {
if (@{$self->{nicks}->{$channel}} and $self->{nicks}->{$channel}->[0]->[0] <= $now - 15) { 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 Time::HiRes qw/gettimeofday/;
use POSIX qw/strftime/; use POSIX qw/strftime/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat', $conf{antirepeat} // 1); $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_threshold', $conf{antirepeat_threshold} // 2.5);
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat_match', $conf{antirepeat_match} // 0.5); $self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat_match', $conf{antirepeat_match} // 0.5);
@ -27,16 +26,13 @@ sub initialize {
$self->{offenses} = {}; $self->{offenses} = {};
} }
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{event_queue}->dequeue_event('antirepeat .*'); $self->{pbot}->{event_queue}->dequeue_event('antirepeat .*');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
} }
sub on_public { sub on_public($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $msg) = ( my ($nick, $user, $host, $msg) = (
$event->nick, $event->nick,
$event->user, $event->user,

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

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

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

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

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

@ -2,20 +2,18 @@
# #
# Purpose: Base class for PBot plugins. # 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 # SPDX-License-Identifier: MIT
package PBot::Plugin::Base; package PBot::Plugin::Base;
use PBot::Imports; use PBot::Imports;
sub new { sub new($class, %args) {
my ($class, %args) = @_;
if (not exists $args{pbot}) { if (not exists $args{pbot}) {
my ($package, $filename, $line) = caller(0); my ($package, $filename, $line) = caller(0);
my (undef, undef, undef, $subroutine) = caller(1); 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; my $self = bless {}, $class;

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

@ -59,9 +59,7 @@ my %color = (
reset => "\x0F", reset => "\x0F",
); );
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# register `battleship` bot command # register `battleship` bot command
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'battleship', name => 'battleship',
@ -128,9 +126,7 @@ sub initialize {
); );
} }
sub unload { sub unload($self) {
my ($self) = @_;
# unregister `battleship` bot command # unregister `battleship` bot command
$self->{pbot}->{commands}->remove('battleship'); $self->{pbot}->{commands}->remove('battleship');
@ -148,9 +144,7 @@ sub unload {
# disconnected with 'excess flood'). this event handler resumes the game once # disconnected with 'excess flood'). this event handler resumes the game once
# the boards have finished transmitting, unless the game was manually paused # the boards have finished transmitting, unless the game was manually paused
# by a player. # by a player.
sub on_output_queue_empty { sub on_output_queue_empty($self, $event_type, $event) {
my ($self) = @_; # we don't care about the other event arguments
# if we're paused waiting for the output queue, go ahead and unpause # if we're paused waiting for the output queue, go ahead and unpause
if ($self->{state_data}->{paused} == $self->{PAUSED_FOR_OUTPUT_QUEUE}) { if ($self->{state_data}->{paused} == $self->{PAUSED_FOR_OUTPUT_QUEUE}) {
$self->{state_data}->{paused} = 0; $self->{state_data}->{paused} = 0;
@ -160,9 +154,7 @@ sub on_output_queue_empty {
} }
# `battleship` bot command # `battleship` bot command
sub cmd_battleship { sub cmd_battleship($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: battleship challenge|accept|decline|ready|unready|bomb|board|score|players|pause|quit|kick|abort; see also: battleship help <command>"; 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 # strip leading and trailing whitespace
@ -485,11 +477,7 @@ sub cmd_battleship {
} }
# add a message to PBot output queue, optionally with a delay # add a message to PBot output queue, optionally with a delay
sub send_message { sub send_message($self, $to, $text, $delay = 0) {
my ($self, $to, $text, $delay) = @_;
$delay //= 0;
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $message = { my $message = {
@ -506,16 +494,13 @@ sub send_message {
} }
# get unambiguous internal id for player hostmask # get unambiguous internal id for player hostmask
sub get_player_id { sub get_player_id($self, $nick, $user, $host) {
my ($self, $nick, $user, $host) = @_;
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host); my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
return $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($id); return $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($id);
} }
# create a new player hash # create a new player hash
sub new_player { sub new_player($self, $id, $nick) {
my ($self, $id, $nick) = @_;
return { return {
id => $id, id => $id,
name => $nick, name => $nick,
@ -533,15 +518,13 @@ sub new_player {
} }
# get a random number interval [lower, upper) # get a random number interval [lower, upper)
sub number { sub number($self, $lower, $upper) {
my ($self, $lower, $upper) = @_;
return int rand($upper - $lower) + $lower; return int rand($upper - $lower) + $lower;
} }
# battleship stuff # battleship stuff
sub begin_game_loop { sub begin_game_loop($self) {
my ($self) = @_;
# add `battleship loop` event repeating at 1s interval # add `battleship loop` event repeating at 1s interval
$self->{pbot}->{event_queue}->enqueue_event( $self->{pbot}->{event_queue}->enqueue_event(
sub { sub {
@ -551,8 +534,7 @@ sub begin_game_loop {
); );
} }
sub end_game_loop { sub end_game_loop($self) {
my ($self) = @_;
# remove `battleship loop` event # remove `battleship loop` event
# repeating events get added back to event queue if we attempt to # 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); $self->{pbot}->{event_queue}->dequeue_event('battleship loop', 0);
} }
sub init_game { sub init_game($self, $state) {
my ($self, $state) = @_;
# default board dimensions # default board dimensions
$self->{N_X} = $self->{BOARD_X}; $self->{N_X} = $self->{BOARD_X};
$self->{N_Y} = $self->{BOARD_Y}; $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) # ensures a ship can be placed at this location (all desired tiles are ocean)
sub check_ship_placement { sub check_ship_placement($self, $x, $y, $o, $l) {
my ($self, $x, $y, $o, $l) = @_;
my ($xd, $yd, $i); my ($xd, $yd, $i);
if ($o == $self->{ORIENT_VERT}) { if ($o == $self->{ORIENT_VERT}) {
@ -625,9 +603,7 @@ sub check_ship_placement {
} }
# attempt to place a ship on the battlefield # attempt to place a ship on the battlefield
sub place_ship { sub place_ship($self, $player_id, $player_index, $ship) {
my ($self, $player_id, $player_index, $ship) = @_;
my ($x, $y, $o, $i, $l); my ($x, $y, $o, $i, $l);
my ($yd, $xd) = (0, 0); my ($yd, $xd) = (0, 0);
@ -702,9 +678,7 @@ sub place_ship {
return 0; return 0;
} }
sub place_whirlpool { sub place_whirlpool($self) {
my ($self) = @_;
for (my $attempt = 0; $attempt < 1000; $attempt++) { for (my $attempt = 0; $attempt < 1000; $attempt++) {
my $x = $self->number(0, $self->{N_X}); my $x = $self->number(0, $self->{N_X});
my $y = $self->number(0, $self->{N_Y}); my $y = $self->number(0, $self->{N_Y});
@ -724,9 +698,7 @@ sub place_whirlpool {
return 0; return 0;
} }
sub generate_battlefield { sub generate_battlefield($self) {
my ($self) = @_;
# fill board with ocean # fill board with ocean
for (my $x = 0; $x < $self->{N_X}; $x++) { for (my $x = 0; $x < $self->{N_X}; $x++) {
for (my $y = 0; $y < $self->{N_Y}; $y++) { 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 # we hit a ship; check if the ship has sunk
sub check_sunk { sub check_sunk($self, $x, $y) {
my ($self, $x, $y) = @_;
# alias to the tile we hit # alias to the tile we hit
my $tile = $self->{board}->[$x][$y]; my $tile = $self->{board}->[$x][$y];
@ -791,9 +761,7 @@ sub check_sunk {
} }
} }
sub get_attack_text { sub get_attack_text($self) {
my ($self) = @_;
my @attacks = ( my @attacks = (
"launches torpedoes at", "launches torpedoes at",
"launches nukes at", "launches nukes at",
@ -810,9 +778,7 @@ sub get_attack_text {
# checks if we hit whirlpool, ocean, ship, etc # checks if we hit whirlpool, ocean, ship, etc
# reveals struck whirlpools # reveals struck whirlpools
sub check_hit { sub check_hit($self, $state, $player, $location_data) {
my ($self, $state, $player, $location_data) = @_;
my ($x, $y, $location) = ( my ($x, $y, $location) = (
$location_data->{x}, $location_data->{x},
$location_data->{y}, $location_data->{y},
@ -874,9 +840,7 @@ sub check_hit {
return 0; return 0;
} }
sub perform_attack { sub perform_attack($self, $state, $player) {
my ($self, $state, $player) = @_;
$player->{shots}++; $player->{shots}++;
# random attack verb # random attack verb
@ -975,9 +939,7 @@ sub perform_attack {
} }
} }
sub list_players { sub list_players($self) {
my ($self) = @_;
my @players; my @players;
foreach my $player (@{$self->{state_data}->{players}}) { foreach my $player (@{$self->{state_data}->{players}}) {
@ -989,9 +951,7 @@ sub list_players {
} }
} }
sub show_scoreboard { sub show_scoreboard($self) {
my ($self) = @_;
foreach my $player (sort { $b->{health} <=> $a->{health} } @{$self->{state_data}->{players}}) { foreach my $player (sort { $b->{health} <=> $a->{health} } @{$self->{state_data}->{players}}) {
next if $player->{removed}; next if $player->{removed};
@ -1010,9 +970,7 @@ sub show_scoreboard {
} }
} }
sub show_battlefield { sub show_battlefield($self, $player_index, $nick) {
my ($self, $player_index, $nick) = @_;
$self->{pbot}->{logger}->log("Showing battlefield for player $player_index\n"); $self->{pbot}->{logger}->log("Showing battlefield for player $player_index\n");
my $player; my $player;
@ -1173,9 +1131,7 @@ sub show_battlefield {
# game state machine stuff # game state machine stuff
# do one loop of the game engine # do one loop of the game engine
sub run_one_state { sub run_one_state($self) {
my ($self) = @_;
# don't run a game loop if we're paused # don't run a game loop if we're paused
if ($self->{state_data}->{paused}) { if ($self->{state_data}->{paused}) {
return; return;
@ -1243,17 +1199,14 @@ sub run_one_state {
} }
# skip directly to a state # skip directly to a state
sub set_state { sub set_state($self, $newstate) {
my ($self, $newstate) = @_;
$self->{previous_state} = $self->{current_state}; $self->{previous_state} = $self->{current_state};
$self->{current_state} = $newstate; $self->{current_state} = $newstate;
$self->{state_data}->{ticks} = 0; $self->{state_data}->{ticks} = 0;
} }
# set up game state machine # set up game state machine
sub create_states { sub create_states($self) {
my ($self) = @_;
$self->{pbot}->{logger}->log("Battleship: Creating game state machine\n"); $self->{pbot}->{logger}->log("Battleship: Creating game state machine\n");
# initialize default state # initialize default state
@ -1321,15 +1274,12 @@ sub create_states {
# game states # game states
sub state_nogame { sub state_nogame($self, $state) {
my ($self, $state) = @_;
$self->end_game_loop; $self->end_game_loop;
$state->{trans} = 'nogame'; $state->{trans} = 'nogame';
} }
sub state_challenge { sub state_challenge($self, $state) {
my ($self, $state) = @_;
# max number of times to perform tock action # max number of times to perform tock action
$state->{tock_limit} = 5; $state->{tock_limit} = 5;
@ -1378,9 +1328,7 @@ sub state_challenge {
} }
} }
sub state_genboard { sub state_genboard($self, $state) {
my ($self, $state) = @_;
if (!$self->init_game($state)) { if (!$self->init_game($state)) {
$self->{pbot}->{logger}->log("Failed to generate battlefield\n"); $self->{pbot}->{logger}->log("Failed to generate battlefield\n");
$self->send_message($self->{channel}, "Failed to generate a suitable battlefield. Please try again."); $self->send_message($self->{channel}, "Failed to generate a suitable battlefield. Please try again.");
@ -1391,9 +1339,7 @@ sub state_genboard {
} }
} }
sub state_showboard { sub state_showboard($self, $state) {
my ($self, $state) = @_;
# pause the game to send the boards to all the players. # pause the game to send the boards to all the players.
# this is due to output pacing; the messages are trickled out slowly # 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 # to avoid overflowing the ircd's receive queue. we do not want the
@ -1411,9 +1357,7 @@ sub state_showboard {
$state->{trans} = 'next'; $state->{trans} = 'next';
} }
sub state_move { sub state_move($self, $state) {
my ($self, $state) = @_;
# allow 5 tocks before players have missed their move # allow 5 tocks before players have missed their move
$state->{tock_limit} = 5; $state->{tock_limit} = 5;
@ -1493,9 +1437,7 @@ sub state_move {
$state->{trans} = 'wait'; $state->{trans} = 'wait';
} }
sub state_attack { sub state_attack($self, $state) {
my ($self, $state) = @_;
my $trans = 'next'; my $trans = 'next';
foreach my $player (@{$state->{players}}) { foreach my $player (@{$state->{players}}) {
@ -1515,9 +1457,7 @@ sub state_attack {
$state->{trans} = $trans; $state->{trans} = $trans;
} }
sub state_gameover { sub state_gameover($self, $state) {
my ($self, $state) = @_;
if (@{$state->{players}} >= 2) { if (@{$state->{players}} >= 2) {
$self->show_battlefield($self->{BOARD_FINAL}); $self->show_battlefield($self->{BOARD_FINAL});
$self->show_scoreboard; $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 # This plugin was contributed by mannito, based on an earlier version of Battleship.pm
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'connect4', name => 'connect4',
help => 'Connect-4 board game', help => 'Connect-4 board game',
@ -38,8 +36,7 @@ sub initialize {
$self->create_states; $self->create_states;
} }
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{commands}->remove('connect4'); $self->{pbot}->{commands}->remove('connect4');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.part'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.part');
$self->{pbot}->{event_dispatcher}->remove_handler('irc.quit'); $self->{pbot}->{event_dispatcher}->remove_handler('irc.quit');
@ -47,8 +44,7 @@ sub unload {
$self->{pbot}->{event_queue}->dequeue_event('connect4 loop'); $self->{pbot}->{event_queue}->dequeue_event('connect4 loop');
} }
sub on_kick { sub on_kick($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host); my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
my ($victim, $reason) = ($event->to, $event->{args}[1]); my ($victim, $reason) = ($event->to, $event->{args}[1]);
my $channel = $event->{args}[0]; my $channel = $event->{args}[0];
@ -57,8 +53,7 @@ sub on_kick {
return 0; return 0;
} }
sub on_departure { sub on_departure($self, $event_type, $event) {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to); my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
my $type = uc $event->type; my $type = uc $event->type;
return 0 if $type ne 'QUIT' and lc $channel ne $self->{channel}; return 0 if $type ne 'QUIT' and lc $channel ne $self->{channel};
@ -99,8 +94,7 @@ my $MAX_NX = 80;
my $MAX_NY = 12; my $MAX_NY = 12;
# challenge options: CONNS:ROWSxCOLS # challenge options: CONNS:ROWSxCOLS
sub parse_challenge { sub parse_challenge($self, $options) {
my ($self, $options) = @_;
my ($conns, $xy, $nx, $ny); my ($conns, $xy, $nx, $ny);
"x" =~ /x/; # clear $1, $2 ... "x" =~ /x/; # clear $1, $2 ...
@ -132,16 +126,18 @@ sub parse_challenge {
return 0; return 0;
} }
sub cmd_connect4 { sub cmd_connect4($self, $context) {
my ($self, $context) = @_;
my $err;
$context->{arguments} =~ s/^\s+|\s+$//g; $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 $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; my ($command, $arguments, $options) = split / /, $context->{arguments}, 3;
if (defined $command) {
$command = lc $command; $command = lc $command;
} else {
$command = '';
}
given ($command) { given ($command) {
when ('help') { when ('help') {
@ -164,6 +160,8 @@ sub cmd_connect4 {
$self->{N_Y} = $DEFAULT_NY; $self->{N_Y} = $DEFAULT_NY;
$self->{CONNECTIONS} = $DEFAULT_CONNECTIONS; $self->{CONNECTIONS} = $DEFAULT_CONNECTIONS;
my $err;
if ((not length $arguments) || ($arguments =~ m/^\d+.*$/ && not($err = $self->parse_challenge($arguments)))) { if ((not length $arguments) || ($arguments =~ m/^\d+.*$/ && not($err = $self->parse_challenge($arguments)))) {
$self->{current_state} = 'accept'; $self->{current_state} = 'accept';
$self->{state_data} = {players => [], counter => 0}; $self->{state_data} = {players => [], counter => 0};
@ -351,9 +349,7 @@ sub cmd_connect4 {
return ""; return "";
} }
sub player_left { sub player_left($self, $nick, $user, $host) {
my ($self, $nick, $user, $host) = @_;
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host); my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
my $removed = 0; my $removed = 0;
@ -371,8 +367,7 @@ sub player_left {
} }
} }
sub send_message { sub send_message($self, $to, $text, $delay) {
my ($self, $to, $text, $delay) = @_;
$delay = 0 if not defined $delay; $delay = 0 if not defined $delay;
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $message = { my $message = {
@ -387,9 +382,7 @@ sub send_message {
$self->{pbot}->{interpreter}->add_message_to_output_queue($to, $message, $delay); $self->{pbot}->{interpreter}->add_message_to_output_queue($to, $message, $delay);
} }
sub run_one_state { sub run_one_state($self) {
my $self = shift;
# check for naughty or missing players # check for naughty or missing players
if ($self->{current_state} =~ /(?:move|accept)/) { if ($self->{current_state} =~ /(?:move|accept)/) {
my $removed = 0; my $removed = 0;
@ -461,9 +454,7 @@ sub run_one_state {
$self->{state_data}->{ticks}++; $self->{state_data}->{ticks}++;
} }
sub create_states { sub create_states($self) {
my $self = shift;
$self->{pbot}->{logger}->log("Connect4: Creating game state machine\n"); $self->{pbot}->{logger}->log("Connect4: Creating game state machine\n");
$self->{previous_state} = ''; $self->{previous_state} = '';
@ -502,9 +493,7 @@ sub create_states {
# connect4 stuff # connect4 stuff
sub init_game { sub init_game($self, $nick1, $nick2) {
my ($self, $nick1, $nick2) = @_;
$self->{chips} = 0; $self->{chips} = 0;
$self->{draw} = 0; $self->{draw} = 0;
@ -522,8 +511,7 @@ sub init_game {
$self->generate_board; $self->generate_board;
} }
sub generate_board { sub generate_board($self) {
my ($self) = @_;
my ($x, $y); my ($x, $y);
for ($y = 0; $y < $self->{N_Y}; $y++) { for ($y = 0; $y < $self->{N_Y}; $y++) {
@ -531,8 +519,7 @@ sub generate_board {
} }
} }
sub check_one { sub check_one($self, $y, $x, $prev) {
my ($self, $y, $x, $prev) = @_;
my $chip = $self->{board}[$y][$x]; my $chip = $self->{board}[$y][$x];
push @{$self->{winner_line}}, "$y $x"; push @{$self->{winner_line}}, "$y $x";
@ -542,8 +529,7 @@ sub check_one {
return (scalar @{$self->{winner_line}} == $self->{CONNECTIONS}, $chip); return (scalar @{$self->{winner_line}} == $self->{CONNECTIONS}, $chip);
} }
sub connected { sub connected($self) {
my ($self) = @_;
my ($i, $j, $row, $col, $prev) = (0, 0, 0, 0, 0); my ($i, $j, $row, $col, $prev) = (0, 0, 0, 0, 0);
my $rv; my $rv;
@ -605,8 +591,7 @@ sub connected {
return 0; return 0;
} }
sub column_top { sub column_top($self, $x) {
my ($self, $x) = @_;
my $y; my $y;
for ($y = 0; $y < $self->{N_Y}; $y++) { for ($y = 0; $y < $self->{N_Y}; $y++) {
@ -615,8 +600,7 @@ sub column_top {
return -1; # shouldnt happen return -1; # shouldnt happen
} }
sub play { sub play($self, $player, $location) {
my ($self, $player, $location) = @_;
my ($draw, $c4, $x, $y); my ($draw, $c4, $x, $y);
$x = $location - 1; $x = $location - 1;
@ -652,8 +636,7 @@ sub play {
return 1; return 1;
} }
sub show_board { sub show_board($self) {
my ($self) = @_;
my ($x, $y, $buf, $chip, $c); my ($x, $y, $buf, $chip, $c);
$self->{pbot}->{logger}->log("showing board\n"); $self->{pbot}->{logger}->log("showing board\n");
@ -683,9 +666,11 @@ sub show_board {
for ($y = 0; $y < $self->{N_Y}; $y++) { for ($y = 0; $y < $self->{N_Y}; $y++) {
for ($x = 0; $x < $self->{N_X}; $x++) { for ($x = 0; $x < $self->{N_X}; $x++) {
$chip = $self->{board}->[$y][$x]; $chip = $self->{board}->[$y][$x];
my $rc = "$y $x"; my $rc = "$y $x";
$c = $chip eq 'O' ? $color{red} : $color{yellow}; $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 .= $color{blue} . "[";
@ -702,16 +687,13 @@ sub show_board {
# state subroutines # state subroutines
sub nogame { sub nogame($self, $state) {
my ($self, $state) = @_;
$state->{result} = 'nogame'; $state->{result} = 'nogame';
$self->{pbot}->{event_queue}->update_repeating('connect4 loop', 0); $self->{pbot}->{event_queue}->update_repeating('connect4 loop', 0);
return $state; return $state;
} }
sub accept { sub accept($self, $state) {
my ($self, $state) = @_;
$state->{max_count} = 3; $state->{max_count} = 3;
if ($state->{players}->[1]->{accepted}) { if ($state->{players}->[1]->{accepted}) {
@ -743,16 +725,14 @@ sub accept {
return $state; return $state;
} }
sub genboard { sub genboard($self, $state) {
my ($self, $state) = @_;
$self->init_game($state->{players}->[0]->{name}, $state->{players}->[1]->{name}); $self->init_game($state->{players}->[0]->{name}, $state->{players}->[1]->{name});
$state->{max_count} = 3; $state->{max_count} = 3;
$state->{result} = 'next'; $state->{result} = 'next';
return $state; return $state;
} }
sub showboard { sub showboard($self, $state) {
my ($self, $state) = @_;
$self->send_message($self->{channel}, "Showing board ..."); $self->send_message($self->{channel}, "Showing board ...");
$self->show_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!"); $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; return $state;
} }
sub playermove { sub playermove($self, $state) {
my ($self, $state) = @_;
my $tock; 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}) { if ($self->{player}->[$state->{current_player}]->{done}) {
$self->{pbot}->{logger}->log("playermove: player $state->{current_player} done, nexting\n"); $self->{pbot}->{logger}->log("playermove: player $state->{current_player} done, nexting\n");
@ -798,20 +780,18 @@ sub playermove {
return $state; return $state;
} }
sub checkplayer { sub checkplayer($self, $state) {
my ($self, $state) = @_; if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) {
$state->{result} = 'end';
if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) { $state->{result} = 'end'; } } else {
else { $state->{result} = 'next'; } $state->{result} = 'next';
}
return $state; return $state;
} }
sub gameover { sub gameover($self, $state) {
my ($self, $state) = @_;
my $buf;
if ($state->{ticks} % 2 == 0) { if ($state->{ticks} % 2 == 0) {
$self->show_board; $self->show_board;
$self->send_message($self->{channel}, $buf);
$self->send_message($self->{channel}, "Game over!"); $self->send_message($self->{channel}, "Game over!");
$state->{players} = []; $state->{players} = [];
$state->{counter} = 0; $state->{counter} = 0;

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

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

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

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

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

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

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

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

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

@ -10,8 +10,7 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{functions}->register( $self->{pbot}->{functions}->register(
'sed', 'sed',
{ {
@ -22,16 +21,14 @@ sub initialize {
); );
} }
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{functions}->unregister('sed'); $self->{pbot}->{functions}->unregister('sed');
} }
# near-verbatim insertion of krok's `sed` factoid # near-verbatim insertion of krok's `sed` factoid
no warnings; no warnings;
sub func_sed { sub func_sed($self, @rest) {
my $self = shift; my $text = "@rest";
my $text = "@_";
my $result = eval { my $result = eval {
if ($text =~ /^s(.)(.*?)(?<!\\)\1(.*?)(?<!\\)\1(\S*)\s+(.*)/p) { 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 # 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 # SPDX-License-Identifier: MIT
package PBot::Plugin::GetUrl; package PBot::Plugin::GetUrl;
@ -14,23 +14,18 @@ use PBot::Imports;
use LWP::UserAgent::Paranoid; use LWP::UserAgent::Paranoid;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{registry}->add_default('text', 'geturl', 'enabled', 1); $self->{pbot}->{registry}->add_default('text', 'geturl', 'enabled', 1);
$self->{pbot}->{registry}->add_default('text', 'geturl', 'max_size', 1024 * 1024); $self->{pbot}->{registry}->add_default('text', 'geturl', 'max_size', 1024 * 1024);
$self->{pbot}->{commands}->register(sub { $self->cmd_geturl(@_) }, 'geturl', 0); $self->{pbot}->{commands}->register(sub { $self->cmd_geturl(@_) }, 'geturl', 0);
} }
sub unload { sub unload($self) {
my ($self) = @_;
$self->{pbot}->{commands}->unregister('geturl'); $self->{pbot}->{commands}->unregister('geturl');
} }
sub cmd_geturl { sub cmd_geturl($self, $context) {
my ($self, $context) = @_;
return "Usage: geturl <url>\n" if not length $context->{arguments}; return "Usage: geturl <url>\n" if not length $context->{arguments};
my $enabled = $self->{pbot}->{registry}->get_value('geturl', 'enabled'); 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/; use Time::Duration qw/duration/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'pd', name => 'pd',
help => 'Simple command to test ParseDate interface', help => 'Simple command to test ParseDate interface',
@ -22,13 +21,11 @@ sub initialize {
); );
} }
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{commands}->remove('pd'); $self->{pbot}->{commands}->remove('pd');
} }
sub cmd_parsedate { sub cmd_parsedate($self, $context) {
my ($self, $context) = @_;
my ($seconds, $error) = $self->{pbot}->{parsedate}->parsedate($context->{arguments}); my ($seconds, $error) = $self->{pbot}->{parsedate}->parsedate($context->{arguments});
return $error if defined $error; return $error if defined $error;
return duration $seconds; return duration $seconds;

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

@ -11,9 +11,7 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports; use PBot::Imports;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# load Plang module # load Plang module
my $path = $self->{pbot}->{registry}->get_value('general', 'plang_dir') // 'Plang'; my $path = $self->{pbot}->{registry}->get_value('general', 'plang_dir') // 'Plang';
unshift @INC, "$path/lib" if not grep { $_ eq "$path/lib" } @INC; unshift @INC, "$path/lib" if not grep { $_ eq "$path/lib" } @INC;
@ -89,16 +87,13 @@ sub initialize {
} }
# runs when plugin is unloaded # runs when plugin is unloaded
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{commands}->unregister('plang'); $self->{pbot}->{commands}->unregister('plang');
$self->{pbot}->{commands}->unregister('plangrepl'); $self->{pbot}->{commands}->unregister('plangrepl');
delete $INC{"Plang/Interpreter.pm"}; delete $INC{"Plang/Interpreter.pm"};
} }
sub cmd_plang { sub cmd_plang($self, $context) {
my ($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"; 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}; return $usage if not length $context->{arguments};
@ -121,9 +116,7 @@ sub cmd_plang {
return length $self->{output} ? $self->{output} : "No output."; return length $self->{output} ? $self->{output} : "No output.";
} }
sub cmd_plangrepl { sub cmd_plangrepl($self, $context) {
my ($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"; 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}; return $usage if not length $context->{arguments};
@ -146,8 +139,7 @@ sub cmd_plangrepl {
} }
# overridden `print` built-in # overridden `print` built-in
sub plang_builtin_print { sub plang_builtin_print($self, $plang, $context, $name, $arguments) {
my ($self, $plang, $context, $name, $arguments) = @_;
my ($expr, $end) = ($plang->output_value($arguments->[0]), $arguments->[1]->[1]); my ($expr, $end) = ($plang->output_value($arguments->[0]), $arguments->[1]->[1]);
$self->{output} .= "$expr$end"; $self->{output} .= "$expr$end";
return [['TYPE', 'Null'], undef]; return [['TYPE', 'Null'], undef];
@ -159,13 +151,11 @@ sub plang_validate_builtin_print {
# our custom PBot built-in functions for Plang # our custom PBot built-in functions for Plang
sub is_locked { sub is_locked($self, $channel, $keyword) {
my ($self, $channel, $keyword) = @_;
return $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, 'locked'); return $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, 'locked');
} }
sub plang_builtin_factget { sub plang_builtin_factget($self, $plang, $context, $name, $arguments) {
my ($self, $plang, $context, $name, $arguments) = @_;
my ($channel, $keyword, $meta) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]); my ($channel, $keyword, $meta) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]);
my $result = $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, $meta); my $result = $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, $meta);
if (defined $result) { if (defined $result) {
@ -179,8 +169,7 @@ sub plang_validate_builtin_factget {
return [['TYPE', 'String'], ""]; return [['TYPE', 'String'], ""];
} }
sub plang_builtin_factset { sub plang_builtin_factset($self, $plang, $context, $name, $arguments) {
my ($self, $plang, $context, $name, $arguments) = @_;
my ($channel, $keyword, $text) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]); 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); 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); $self->{pbot}->{factoids}->{data}->add('text', $channel, 'Plang', $keyword, $text);
@ -191,8 +180,7 @@ sub plang_validate_builtin_factset {
return [['TYPE', 'String'], ""]; return [['TYPE', 'String'], ""];
} }
sub plang_builtin_factappend { sub plang_builtin_factappend($self, $plang, $context, $name, $arguments) {
my ($self, $plang, $context, $name, $arguments) = @_;
my ($channel, $keyword, $text) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]); 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); 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'); my $action = $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, 'action');
@ -206,8 +194,7 @@ sub plang_validate_builtin_factappend {
return [['TYPE', 'String'], ""]; return [['TYPE', 'String'], ""];
} }
sub plang_builtin_userget { sub plang_builtin_userget($self, $plang, $context, $name, $arguments) {
my ($self, $plang, $context, $name, $arguments) = @_;
my ($username) = ($arguments->[0], $arguments->[1]); my ($username) = ($arguments->[0], $arguments->[1]);
my $user = $self->{pbot}->{users}->{storage}->get_data($username->[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); use POSIX qw(strftime);
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{filename} = $conf{quotegrabs_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.sqlite3'; $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}); $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' ); $self->{pbot}->{commands}->register(sub { $self->cmd_show_random_quotegrab(@_) }, 'rq' );
} }
sub unload { sub unload($self) {
my ($self) = @_;
$self->{pbot}->{commands}->unregister('grab'); $self->{pbot}->{commands}->unregister('grab');
$self->{pbot}->{commands}->unregister('getq'); $self->{pbot}->{commands}->unregister('getq');
$self->{pbot}->{commands}->unregister('delq'); $self->{pbot}->{commands}->unregister('delq');
@ -50,9 +48,7 @@ sub unload {
sub uniq { my %seen; grep !$seen{$_}++, @_ } sub uniq { my %seen; grep !$seen{$_}++, @_ }
sub export_quotegrabs { sub export_quotegrabs($self) {
my $self = shift;
$self->{export_path} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.html'; $self->{export_path} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.html';
my $quotegrabs = $self->{database}->get_all_quotegrabs; my $quotegrabs = $self->{database}->get_all_quotegrabs;
@ -153,9 +149,7 @@ sub export_quotegrabs {
return "$i quotegrabs exported."; return "$i quotegrabs exported.";
} }
sub cmd_grab_quotegrab { sub cmd_grab_quotegrab($self, $context) {
my ($self, $context) = @_;
if (not length $context->{arguments}) { if (not length $context->{arguments}) {
return 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"; "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 { sub cmd_delete_quotegrab($self, $context) {
my ($self, $context) = @_;
my $quotegrab = $self->{database}->get_quotegrab($context->{arguments}); my $quotegrab = $self->{database}->get_quotegrab($context->{arguments});
if (not defined $quotegrab) { if (not defined $quotegrab) {
@ -293,9 +285,7 @@ sub cmd_delete_quotegrab {
} }
} }
sub cmd_show_quotegrab { sub cmd_show_quotegrab($self, $context) {
my ($self, $context) = @_;
my $quotegrab = $self->{database}->get_quotegrab($context->{arguments}); my $quotegrab = $self->{database}->get_quotegrab($context->{arguments});
if (not defined $quotegrab) { if (not defined $quotegrab) {
@ -316,9 +306,7 @@ sub cmd_show_quotegrab {
} }
} }
sub cmd_show_random_quotegrab { sub cmd_show_random_quotegrab($self, $context) {
my ($self, $context) = @_;
my $usage = 'Usage: rq [nick [channel [text]]] [-c <channel>] [-t <text>]'; my $usage = 'Usage: rq [nick [channel [text]]] [-c <channel>] [-t <text>]';
my ($nick_search, $channel_search, $text_search); my ($nick_search, $channel_search, $text_search);

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

@ -1,8 +1,13 @@
# File: Hashtable.pm # File: Hashtable.pm
# #
# Purpose: Hashtable backend for storing and retreiving quotegrabs. # 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 # SPDX-License-Identifier: MIT
package PBot::Plugin::Quotegrabs::Storage::Hashtable; package PBot::Plugin::Quotegrabs::Storage::Hashtable;
@ -16,31 +21,22 @@ use Getopt::Long qw(GetOptionsFromString);
use POSIX qw(strftime); use POSIX qw(strftime);
sub new { sub new($class, %conf) {
if (ref($_[1]) eq 'HASH') { Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference"); }
my ($class, %conf) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
$self->initialize(%conf); $self->initialize(%conf);
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference in " . __FILE__); $self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference in " . __FILE__);
$self->{filename} = delete $conf{filename}; $self->{filename} = delete $conf{filename};
$self->{quotegrabs} = []; $self->{quotegrabs} = [];
} }
sub begin { sub begin($self) {
my $self = shift;
$self->load_quotegrabs; $self->load_quotegrabs;
} }
sub end { }
sub load_quotegrabs { sub load_quotegrabs {
my $self = shift; my $self = shift;
my $filename; my $filename;
@ -96,37 +92,30 @@ sub save_quotegrabs {
close(FILE); close(FILE);
} }
sub add_quotegrab { sub add_quotegrab($self, $quotegrab) {
my ($self, $quotegrab) = @_;
push @{$self->{quotegrabs}}, $quotegrab; push @{$self->{quotegrabs}}, $quotegrab;
$self->save_quotegrabs(); $self->save_quotegrabs();
return $#{$self->{quotegrabs}} + 1; return $#{$self->{quotegrabs}} + 1;
} }
sub delete_quotegrab { sub delete_quotegrab($self, $id) {
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; 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(); $self->save_quotegrabs();
} }
sub get_quotegrab { sub get_quotegrab($self, $id) {
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]; return $self->{quotegrabs}[$id - 1];
} }
sub get_random_quotegrab { sub get_random_quotegrab($self, $nick, $channel, $text) {
my ($self, $nick, $channel, $text) = @_;
$nick = '.*' if not defined $nick; $nick = '.*' if not defined $nick;
$channel = '.*' if not defined $channel; $channel = '.*' if not defined $channel;
$text = '.*' if not defined $text; $text = '.*' if not defined $text;
@ -153,8 +142,7 @@ sub get_random_quotegrab {
return $quotes[int rand($#quotes + 1)]; return $quotes[int rand($#quotes + 1)];
} }
sub get_all_quotegrabs { sub get_all_quotegrabs($self) {
my $self = shift;
return $self->{quotegrabs}; return $self->{quotegrabs};
} }

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

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

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

@ -16,9 +16,7 @@ use PBot::Imports;
use Storable qw/dclone/; use Storable qw/dclone/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'mod', 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.', 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 { sub unload($self) {
my ($self) = @_;
$self->{pbot}->{commands}->remove('mod'); $self->{pbot}->{commands}->remove('mod');
$self->{pbot}->{capabilities}->remove('chanmod'); $self->{pbot}->{capabilities}->remove('chanmod');
} }
sub help { sub help($self, $context) {
my ($self, $context) = @_;
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // 'help'; my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // 'help';
if (exists $self->{commands}->{$command}) { if (exists $self->{commands}->{$command}) {
@ -58,14 +54,11 @@ sub help {
} }
} }
sub list { sub list($self, $context) {
my ($self, $context) = @_;
return "Available mod commands: " . join ', ', sort keys %{$self->{commands}}; return "Available mod commands: " . join ', ', sort keys %{$self->{commands}};
} }
sub generic_command { sub generic_command($self, $context, $command) {
my ($self, $context, $command) = @_;
my $channel = $context->{from}; my $channel = $context->{from};
if ($channel !~ m/^#/) { if ($channel !~ m/^#/) {
$channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); $channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
@ -147,41 +140,33 @@ sub generic_command {
return ""; return "";
} }
sub kick { sub kick($self, $context) {
my ($self, $context) = @_;
return $self->generic_command($context, 'kick'); return $self->generic_command($context, 'kick');
} }
sub ban { sub ban($self, $context) {
my ($self, $context) = @_;
return $self->generic_command($context, 'ban'); return $self->generic_command($context, 'ban');
} }
sub mute { sub mute($self, $context) {
my ($self, $context) = @_;
return $self->generic_command($context, 'mute'); return $self->generic_command($context, 'mute');
} }
sub unban { sub unban($self, $context) {
my ($self, $context) = @_;
return $self->generic_command($context, 'unban'); return $self->generic_command($context, 'unban');
} }
sub unmute { sub unmute($self, $context) {
my ($self, $context) = @_;
return $self->generic_command($context, 'unmute'); return $self->generic_command($context, 'unmute');
} }
sub kb { sub kb($self, $context) {
my ($self, $context) = @_;
my $result = $self->ban(dclone $context); # note: using copy of $context to preserve $context->{arglist} for $self->kick($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 $result if length $result;
return $self->kick($context); return $self->kick($context);
} }
sub cmd_mod { sub cmd_mod($self, $context) {
my ($self, $context) = @_;
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // ''; my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // '';
$command = lc $command; $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. # 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 # SPDX-License-Identifier: MIT
package PBot::Plugin::RunCommand; package PBot::Plugin::RunCommand;
@ -27,9 +27,7 @@ use PBot::Imports;
use IPC::Run qw/start pump finish/; use IPC::Run qw/start pump finish/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'runcmd', name => 'runcmd',
help => 'Executes a system command and outputs each line in real-time', help => 'Executes a system command and outputs each line in real-time',
@ -38,14 +36,11 @@ sub initialize {
); );
} }
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{commands}->remove('runcmd'); $self->{pbot}->{commands}->remove('runcmd');
} }
sub cmd_runcmd { sub cmd_runcmd($self, $context) {
my ($self, $context) = @_;
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1); my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
my ($in, $out, $err); my ($in, $out, $err);
@ -71,9 +66,7 @@ sub cmd_runcmd {
return "No output." if not $lines; return "No output." if not $lines;
} }
sub send_lines { sub send_lines($self, $context, $buffer, $send_all) {
my ($self, $context, $buffer, $send_all) = @_;
my $lines = 0; my $lines = 0;
my $regex; 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. # 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 # SPDX-License-Identifier: MIT
package PBot::Plugin::Spinach::Rank; package PBot::Plugin::Spinach::Rank;
@ -15,56 +15,47 @@ use lib "$FindBin::RealBin/../../..";
use PBot::Plugin::Spinach::Stats; use PBot::Plugin::Spinach::Stats;
use Math::Expression::Evaluator; use Math::Expression::Evaluator;
sub new { sub new($class, %conf) {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref $_[1] eq 'HASH';
my ($class, %conf) = @_;
my $self = bless {}, $class; my $self = bless {}, $class;
$self->initialize(%conf); $self->initialize(%conf);
return $self; return $self;
} }
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__); $self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
$self->{channel} = $conf{channel} // Carp::croak("Missing channel reference to " . __FILE__); $self->{channel} = $conf{channel} // Carp::croak("Missing channel reference to " . __FILE__);
$self->{filename} = $conf{filename} // 'stats.sqlite'; $self->{filename} = $conf{filename} // 'stats.sqlite';
$self->{stats} = PBot::Plugin::Spinach::Stats->new(pbot => $self->{pbot}, filename => $self->{filename}); $self->{stats} = PBot::Plugin::Spinach::Stats->new(pbot => $self->{pbot}, filename => $self->{filename});
} }
sub sort_generic { sub sort_generic($self, $key) {
my ($self, $key) = @_;
if ($self->{rank_direction} eq '+') { return $b->{$key} <=> $a->{$key}; } if ($self->{rank_direction} eq '+') { return $b->{$key} <=> $a->{$key}; }
else { return $a->{$key} <=> $b->{$key}; } else { return $a->{$key} <=> $b->{$key}; }
} }
sub print_generic { sub print_generic($self, $key, $player) {
my ($self, $key, $player) = @_;
return undef if $player->{games_played} == 0; return undef if $player->{games_played} == 0;
return "$player->{nick}: $player->{$key}"; return "$player->{nick}: $player->{$key}";
} }
sub print_avg_score { sub print_avg_score($self, $player) {
my ($self, $player) = @_;
return undef if $player->{games_played} == 0; return undef if $player->{games_played} == 0;
my $result = int $player->{avg_score}; my $result = int $player->{avg_score};
return "$player->{nick}: $result"; return "$player->{nick}: $result";
} }
sub sort_bad_lies { sub sort_bad_lies($self) {
my ($self) = @_;
if ($self->{rank_direction} eq '+') { return $b->{questions_played} - $b->{good_lies} <=> $a->{questions_played} - $a->{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}; } else { return $a->{questions_played} - $a->{good_lies} <=> $b->{questions_played} - $b->{good_lies}; }
} }
sub print_bad_lies { sub print_bad_lies($self, $player) {
my ($self, $player) = @_;
return undef if $player->{games_played} == 0; return undef if $player->{games_played} == 0;
my $result = $player->{questions_played} - $player->{good_lies}; my $result = $player->{questions_played} - $player->{good_lies};
return "$player->{nick}: $result"; return "$player->{nick}: $result";
} }
sub sort_mentions { sub sort_mentions($self) {
my ($self) = @_;
if ($self->{rank_direction} eq '+') { 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} - 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}; $a->{times_third};
@ -74,16 +65,13 @@ sub sort_mentions {
} }
} }
sub print_mentions { sub print_mentions($self, $player) {
my ($self, $player) = @_;
return undef if $player->{games_played} == 0; return undef if $player->{games_played} == 0;
my $result = $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third}; my $result = $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third};
return "$player->{nick}: $result"; return "$player->{nick}: $result";
} }
sub sort_expr { sub sort_expr($self) {
my ($self) = @_;
my $result = eval { my $result = eval {
my $result_a = $self->{expr}->val( my $result_a = $self->{expr}->val(
{ {
@ -135,9 +123,7 @@ sub sort_expr {
return $result; return $result;
} }
sub print_expr { sub print_expr($self, $player) {
my ($self, $player) = @_;
return undef if $player->{games_played} == 0; return undef if $player->{games_played} == 0;
my $result = eval { my $result = eval {
@ -169,9 +155,7 @@ sub print_expr {
return "$player->{nick}: $result"; return "$player->{nick}: $result";
} }
sub rank { sub rank($self, $arguments) {
my ($self, $arguments) = @_;
my %ranks = ( my %ranks = (
highscore => { highscore => {
sort => sub { $self->sort_generic('high_score', @_) }, sort => sub { $self->sort_generic('high_score', @_) },

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

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

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

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

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

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

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

@ -13,9 +13,7 @@ use PBot::Imports;
use PBot::Core::Utils::LWPUserAgentCached; use PBot::Core::Utils::LWPUserAgentCached;
use XML::LibXML; use XML::LibXML;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'weather', name => 'weather',
help => 'Provides weather service via AccuWeather', help => 'Provides weather service via AccuWeather',
@ -23,14 +21,11 @@ sub initialize {
); );
} }
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{commands}->remove('weather'); $self->{pbot}->{commands}->remove('weather');
} }
sub cmd_weather { sub cmd_weather($self, $context) {
my ($self, $context) = @_;
my $usage = "Usage: weather (<location> | -u <user account>)"; my $usage = "Usage: weather (<location> | -u <user account>)";
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};
@ -67,9 +62,7 @@ sub cmd_weather {
return $self->get_weather($arguments); return $self->get_weather($arguments);
} }
sub get_weather { sub get_weather($self, $location) {
my ($self, $location) = @_;
my %cache_opt = ( my %cache_opt = (
'namespace' => 'accuweather', 'namespace' => 'accuweather',
'default_expires_in' => 3600 'default_expires_in' => 3600
@ -119,8 +112,7 @@ sub get_weather {
return $result; return $result;
} }
sub fix_temps { sub fix_temps($self, $text) {
my ($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; $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; return $text;
} }

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

@ -2,7 +2,7 @@
# #
# Purpose: Query Wolfram|Alpha's Short Answers API. # 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 # SPDX-License-Identifier: MIT
package PBot::Plugin::Wolfram; package PBot::Plugin::Wolfram;
@ -13,9 +13,7 @@ use PBot::Imports;
use LWP::UserAgent::Paranoid; use LWP::UserAgent::Paranoid;
use URI::Escape qw/uri_escape_utf8/; use URI::Escape qw/uri_escape_utf8/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
# add default registry entry for `wolfram.appid` # add default registry entry for `wolfram.appid`
$self->{pbot}->{registry}->add_default('text', 'wolfram', 'appid', ''); $self->{pbot}->{registry}->add_default('text', 'wolfram', 'appid', '');
@ -30,14 +28,11 @@ sub initialize {
); );
} }
sub unload { sub unload($self) {
my ($self) = @_;
$self->{pbot}->{commands}->remove('wolfram'); $self->{pbot}->{commands}->remove('wolfram');
} }
sub cmd_wolfram { sub cmd_wolfram($self, $context) {
my ($self, $context) = @_;
return "Usage: wolfram <query>\n" if not length $context->{arguments}; return "Usage: wolfram <query>\n" if not length $context->{arguments};
my $appid = $self->{pbot}->{registry}->get_value('wolfram', 'appid'); 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 # 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. # 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 # SPDX-License-Identifier: MIT
package PBot::Plugin::WordMorph; package PBot::Plugin::WordMorph;
@ -14,9 +14,7 @@ use PBot::Imports;
use Storable; use Storable;
use Text::Levenshtein::XS 'distance'; use Text::Levenshtein::XS 'distance';
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'wordmorph', 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.', 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($@); or $self->{pbot}->{logger}->log($@);
} }
sub unload { sub unload($self) {
my ($self) = @_;
$self->{pbot}->{commands}->remove('wordmorph'); $self->{pbot}->{commands}->remove('wordmorph');
} }
@ -47,9 +44,7 @@ use constant {
MAX_WORD_LENGTH => 7, MAX_WORD_LENGTH => 7,
}; };
sub wordmorph { sub wordmorph($self, $context) {
my ($self, $context) = @_;
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}); my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments});
my $command = shift @args; my $command = shift @args;
@ -303,9 +298,7 @@ sub wordmorph {
} }
} }
sub load_db { sub load_db($self) {
my ($self) = @_;
if (not -e $self->{db_path}) { if (not -e $self->{db_path}) {
die "Word morph database not available; run `/misc/wordmorph/wordmorph-mkdb` to create it.\n"; 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}); return retrieve($self->{db_path});
} }
sub show_morph_with_blanks { sub show_morph_with_blanks($self, $channel) {
my ($self, $channel) = @_;
my @middle; my @middle;
for (1 .. @{$self->{$channel}->{morph}} - 2) { for (1 .. @{$self->{$channel}->{morph}} - 2) {
push @middle, '_' x length $self->{$channel}->{word1}; 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}"; return "$self->{$channel}->{word1} > " . join(' > ', @middle) . " > $self->{$channel}->{word2}";
} }
sub set_up_new_morph { sub set_up_new_morph($self, $morph, $channel) {
my ($self, $morph, $channel) = @_;
$self->{$channel}->{morph} = $morph; $self->{$channel}->{morph} = $morph;
$self->{$channel}->{word1} = $morph->[0]; $self->{$channel}->{word1} = $morph->[0];
$self->{$channel}->{word2} = $morph->[$#$morph]; $self->{$channel}->{word2} = $morph->[$#$morph];
@ -333,9 +323,7 @@ sub set_up_new_morph {
$self->{$channel}->{hintR} = $#$morph - 1; $self->{$channel}->{hintR} = $#$morph - 1;
} }
sub form_hint { sub form_hint($word1, $word2) {
my ($word1, $word2) = @_;
my $hint = ''; my $hint = '';
for (0 .. length $word1) { for (0 .. length $word1) {
@ -349,9 +337,7 @@ sub form_hint {
return $hint; return $hint;
} }
sub validate_word { sub validate_word($self, $word, $min, $max) {
my ($self, $word, $min, $max) = @_;
my $len = length $word; my $len = length $word;
if ($len < $min) { if ($len < $min) {
@ -367,9 +353,7 @@ sub validate_word {
return undef; return undef;
} }
sub compare_suffix { sub compare_suffix($word1, $word2) {
my ($word1, $word2) = @_;
my $length = 0; my $length = 0;
for (my $i = length($word1) - 1; $i >= 0; --$i) { for (my $i = length($word1) - 1; $i >= 0; --$i) {
@ -383,9 +367,7 @@ sub compare_suffix {
return $length; return $length;
} }
sub make_morph_by_steps { sub make_morph_by_steps($self, $db, $steps, $length) {
my ($self, $db, $steps, $length) = @_;
$length //= int(rand(3)) + 5; $length //= int(rand(3)) + 5;
my @words = keys %{$db->{$length}}; 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 # the following subs are based on https://www.perlmonks.org/?node_id=558123
sub makemorph { sub makemorph($db, $left, $right) {
my ($db, $left, $right) = @_;
die "The length of given words are not equal.\n" if length($left) != length($right); die "The length of given words are not equal.\n" if length($left) != length($right);
my $list = $db->{length $left}; my $list = $db->{length $left};
my $morph = eval { [transform(lc $left, lc $right, $list)] } or die $@; my $morph = eval { [transform(lc $left, lc $right, $list)] } or die $@;
return $morph; return $morph;
} }
sub transform { sub transform($left, $right, $list) {
my ($left, $right, $list) = @_;
my (@left, %left, @right, %right); # @left and @right- arrays containing word relation trees: ([foo], [0, foe], [0, fou], [0, 1, fie] ...) 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 # %left and %right - indices containing word offsets in arrays @left and @right
@ -502,9 +481,7 @@ sub transform {
return @path; return @path;
} }
sub print_rel { sub print_rel($id, $ary) {
my ($id, $ary) = @_;
my @rel = @{$ary->[$id]}; my @rel = @{$ary->[$id]};
my @line; my @line;

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

@ -14,9 +14,7 @@ use PBot::Core::Utils::LWPUserAgentCached;
use JSON; use JSON;
use URI::Escape qw/uri_escape_utf8/; use URI::Escape qw/uri_escape_utf8/;
sub initialize { sub initialize($self, %conf) {
my ($self, %conf) = @_;
$self->{pbot}->{commands}->add( $self->{pbot}->{commands}->add(
name => 'wttr', name => 'wttr',
help => 'Provides weather information via wttr.in', help => 'Provides weather information via wttr.in',
@ -24,14 +22,11 @@ sub initialize {
); );
} }
sub unload { sub unload($self) {
my $self = shift;
$self->{pbot}->{commands}->remove('wttr'); $self->{pbot}->{commands}->remove('wttr');
} }
sub cmd_wttr { sub cmd_wttr($self, $context) {
my ($self, $context) = @_;
my $arguments = $context->{arguments}; my $arguments = $context->{arguments};
my @wttr_options = ( my @wttr_options = (
@ -104,9 +99,7 @@ sub cmd_wttr {
return $self->get_wttr($arguments, \@opts, \@wttr_options); return $self->get_wttr($arguments, \@opts, \@wttr_options);
} }
sub get_wttr { sub get_wttr($self, $location, $options, $order) {
my ($self, $location, $options, $order) = @_;
my %cache_opt = ( my %cache_opt = (
'namespace' => 'wttr', 'namespace' => 'wttr',
'default_expires_in' => 900 '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 # These are set by the /misc/update_version script
use constant { use constant {
BUILD_NAME => "PBot", BUILD_NAME => "PBot",
BUILD_REVISION => 4645, BUILD_REVISION => 4646,
BUILD_DATE => "2023-04-13", BUILD_DATE => "2023-04-13",
}; };