mirror of
https://github.com/pragma-/pbot.git
synced 2024-12-23 03:02:47 +01:00
Update plugins to use subroutine signatures
This commit is contained in:
Pragmatic Software
parent
afd07bcd57
commit
cd60ac9fc7
@ -43,9 +43,7 @@ use DBI;
|
||||
use Time::Duration qw/duration/;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
# register bot command
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'actiontrigger',
|
||||
@ -73,9 +71,7 @@ sub initialize {
|
||||
$self->create_database;
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
|
||||
sub unload($self) {
|
||||
# close database
|
||||
$self->dbi_end;
|
||||
|
||||
@ -94,9 +90,7 @@ sub unload {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.kick');
|
||||
}
|
||||
|
||||
sub cmd_actiontrigger {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_actiontrigger($self, $context) {
|
||||
# database not available
|
||||
return "Internal error." if not $self->{dbh};
|
||||
|
||||
@ -253,9 +247,7 @@ sub cmd_actiontrigger {
|
||||
}
|
||||
}
|
||||
|
||||
sub create_database {
|
||||
my $self = shift;
|
||||
|
||||
sub create_database($self) {
|
||||
return if not $self->{dbh};
|
||||
|
||||
eval {
|
||||
@ -275,9 +267,7 @@ SQL
|
||||
$self->{pbot}->{logger}->log("ActionTrigger create database failed: $@") if $@;
|
||||
}
|
||||
|
||||
sub dbi_begin {
|
||||
my ($self) = @_;
|
||||
|
||||
sub dbi_begin($self) {
|
||||
eval {
|
||||
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
|
||||
or die $DBI::errstr;
|
||||
@ -291,16 +281,13 @@ sub dbi_begin {
|
||||
}
|
||||
}
|
||||
|
||||
sub dbi_end {
|
||||
my ($self) = @_;
|
||||
sub dbi_end($self) {
|
||||
return if not $self->{dbh};
|
||||
$self->{dbh}->disconnect;
|
||||
delete $self->{dbh};
|
||||
}
|
||||
|
||||
sub add_trigger {
|
||||
my ($self, $channel, $trigger, $action, $owner, $cap_override, $ratelimit) = @_;
|
||||
|
||||
sub add_trigger($self, $channel, $trigger, $action, $owner, $cap_override, $ratelimit) {
|
||||
return 0 if $self->get_trigger($channel, $trigger);
|
||||
|
||||
eval {
|
||||
@ -316,17 +303,14 @@ sub add_trigger {
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub delete_trigger {
|
||||
my ($self, $channel, $trigger) = @_;
|
||||
sub delete_trigger($self, $channel, $trigger) {
|
||||
return 0 if not $self->get_trigger($channel, $trigger);
|
||||
my $sth = $self->{dbh}->prepare('DELETE FROM Triggers WHERE channel = ? AND trigger = ?');
|
||||
$sth->execute(lc $channel, $trigger);
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub list_triggers {
|
||||
my ($self, $channel) = @_;
|
||||
|
||||
sub list_triggers($self, $channel) {
|
||||
my $triggers = eval {
|
||||
my $sth;
|
||||
|
||||
@ -347,9 +331,7 @@ sub list_triggers {
|
||||
return @$triggers;
|
||||
}
|
||||
|
||||
sub update_trigger {
|
||||
my ($self, $channel, $trigger, $data) = @_;
|
||||
|
||||
sub update_trigger($self, $channel, $trigger, $data) {
|
||||
eval {
|
||||
my $sql = 'UPDATE Triggers SET ';
|
||||
|
||||
@ -374,9 +356,7 @@ sub update_trigger {
|
||||
$self->{pbot}->{logger}->log("Update trigger $channel/$trigger failed: $@\n") if $@;
|
||||
}
|
||||
|
||||
sub get_trigger {
|
||||
my ($self, $channel, $trigger) = @_;
|
||||
|
||||
sub get_trigger($self, $channel, $trigger) {
|
||||
my $row = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT * FROM Triggers WHERE channel = ? AND trigger = ?');
|
||||
$sth->execute(lc $channel, $trigger);
|
||||
@ -392,9 +372,7 @@ sub get_trigger {
|
||||
return $row;
|
||||
}
|
||||
|
||||
sub on_kick {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_kick($self, $event_type, $event) {
|
||||
# don't handle this event if it was caused by a bot command
|
||||
return 0 if $event->{interpreted};
|
||||
|
||||
@ -415,9 +393,7 @@ sub on_kick {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_action {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_action($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
@ -433,14 +409,13 @@ sub on_action {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
$event->host,
|
||||
$event->args);
|
||||
$event->args
|
||||
);
|
||||
|
||||
my $channel = $event->{to}[0];
|
||||
|
||||
@ -448,9 +423,7 @@ sub on_public {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_join {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_join($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $channel, $args) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
@ -463,9 +436,7 @@ sub on_join {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_departure {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_departure($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $channel, $args) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
@ -478,9 +449,7 @@ sub on_departure {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub check_trigger {
|
||||
my ($self, $nick, $user, $host, $channel, $text) = @_;
|
||||
|
||||
sub check_trigger($self, $nick, $user, $host, $channel, $text) {
|
||||
# database not available
|
||||
return 0 if not $self->{dbh};
|
||||
|
||||
|
||||
@ -10,9 +10,7 @@ use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{registry}->add_default('text', 'antiaway', 'bad_nicks',
|
||||
$conf{bad_nicks} // '([[:punct:]](afk|brb|bbl|away|sleep|z+|work|gone|study|out|home|busy|off)[[:punct:]]*$|.+\[.*\]$)'
|
||||
);
|
||||
@ -24,15 +22,12 @@ sub initialize {
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action(@_) });
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.nick');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
|
||||
}
|
||||
|
||||
sub on_nickchange {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_nickchange($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $newnick) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
@ -60,9 +55,7 @@ sub on_nickchange {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_action {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_action($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg, $channel) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
|
||||
@ -13,8 +13,7 @@ use PBot::Imports;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Time::Duration;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{registry}->add_default('array', 'antikickautorejoin', 'punishment', '30,90,180,300,28800');
|
||||
$self->{pbot}->{registry}->add_default('text', 'antikickautorejoin', 'threshold', '2');
|
||||
|
||||
@ -23,14 +22,12 @@ sub initialize {
|
||||
$self->{kicks} = {};
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.kick');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.join');
|
||||
}
|
||||
|
||||
sub on_kick {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_kick($self, $event_type, $event) {
|
||||
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
|
||||
my ($target, $channel, $reason) = ($event->to, $event->{args}[0], $event->{args}[1]);
|
||||
|
||||
@ -46,8 +43,7 @@ sub on_kick {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_join {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_join($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
|
||||
|
||||
$channel = lc $channel;
|
||||
|
||||
@ -14,21 +14,18 @@ use PBot::Imports;
|
||||
use Time::Duration qw/duration/;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action(@_) });
|
||||
$self->{nicks} = {};
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
|
||||
}
|
||||
|
||||
sub on_action {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_action($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
|
||||
my $channel = $event->{to}[0];
|
||||
return 0 if $event->{interpreted};
|
||||
@ -36,8 +33,7 @@ sub on_action {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
|
||||
my $channel = $event->{to}[0];
|
||||
return 0 if $event->{interpreted};
|
||||
@ -45,8 +41,7 @@ sub on_public {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub check_flood {
|
||||
my ($self, $nick, $user, $host, $channel, $msg) = @_;
|
||||
sub check_flood($self, $nick, $user, $host, $channel, $msg) {
|
||||
return 0 if not $self->{pbot}->{chanops}->can_gain_ops($channel);
|
||||
|
||||
$channel = lc $channel;
|
||||
@ -76,13 +71,12 @@ sub check_flood {
|
||||
}
|
||||
}
|
||||
|
||||
sub clear_old_nicks {
|
||||
my ($self, $channel) = @_;
|
||||
my $now = gettimeofday;
|
||||
sub clear_old_nicks($self, $channel) {
|
||||
return if not exists $self->{nicks}->{$channel};
|
||||
my $now = gettimeofday;
|
||||
|
||||
while (1) {
|
||||
if (@{$self->{nicks}->{$channel}} and $self->{nicks}->{$channel}->[0]->[0] <= $now - 15) {
|
||||
if (@{$self->{nicks}->{$channel}} and $self->{nicks}->{$channel}->[0]->[0] <= $now - 15) {
|
||||
shift @{$self->{nicks}->{$channel}};
|
||||
} else {
|
||||
last;
|
||||
|
||||
@ -14,8 +14,7 @@ use String::LCSS qw/lcss/;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use POSIX qw/strftime/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat', $conf{antirepeat} // 1);
|
||||
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat_threshold', $conf{antirepeat_threshold} // 2.5);
|
||||
$self->{pbot}->{registry}->add_default('text', 'antiflood', 'antirepeat_match', $conf{antirepeat_match} // 0.5);
|
||||
@ -27,16 +26,13 @@ sub initialize {
|
||||
$self->{offenses} = {};
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_queue}->dequeue_event('antirepeat .*');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
|
||||
@ -14,20 +14,17 @@ use PBot::Imports;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Time::Duration qw/duration/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
|
||||
$self->{offenses} = {};
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
$self->{pbot}->{event_queue}->dequeue_event('antitwitter .*');
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $channel, $msg) = ($event->nick, $event->user, $event->host, $event->{to}[0], $event->args);
|
||||
|
||||
return 0 if $event->{interpreted};
|
||||
|
||||
@ -8,26 +8,24 @@
|
||||
package PBot::Plugin::AutoRejoin;
|
||||
use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Time::Duration;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{registry}->add_default('array', 'autorejoin', 'rejoin_delay', '900,1800,3600');
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick(@_) });
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_part(@_) });
|
||||
$self->{rejoins} = {};
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.kick');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.part');
|
||||
}
|
||||
|
||||
sub rejoin_channel {
|
||||
my ($self, $channel) = @_;
|
||||
|
||||
sub rejoin_channel($self, $channel) {
|
||||
if (not exists $self->{rejoins}->{$channel}) {
|
||||
$self->{rejoins}->{$channel}->{rejoins} = 0;
|
||||
}
|
||||
@ -45,9 +43,7 @@ sub rejoin_channel {
|
||||
$self->{rejoins}->{$channel}->{last_rejoin} = gettimeofday;
|
||||
}
|
||||
|
||||
sub on_kick {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_kick($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $target, $channel, $reason) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
@ -67,9 +63,7 @@ sub on_kick {
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub on_part {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_part($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $channel) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
|
||||
@ -2,23 +2,21 @@
|
||||
#
|
||||
# Purpose: Base class for PBot plugins.
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::Base;
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
|
||||
sub new($class, %args) {
|
||||
if (not exists $args{pbot}) {
|
||||
my ($package, $filename, $line) = caller(0);
|
||||
my (undef, undef, undef, $subroutine) = caller(1);
|
||||
Carp::croak("Missing pbot reference to " . $class . ", created by $subroutine at $filename:$line");
|
||||
Carp::croak("Missing pbot reference to $class, created by $subroutine at $filename:$line");
|
||||
}
|
||||
|
||||
my $self = bless {}, $class;
|
||||
my $self = bless {}, $class;
|
||||
$self->{pbot} = $args{pbot};
|
||||
$self->initialize(%args);
|
||||
return $self;
|
||||
|
||||
@ -59,9 +59,7 @@ my %color = (
|
||||
reset => "\x0F",
|
||||
);
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
# register `battleship` bot command
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'battleship',
|
||||
@ -128,9 +126,7 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
|
||||
sub unload($self) {
|
||||
# unregister `battleship` bot command
|
||||
$self->{pbot}->{commands}->remove('battleship');
|
||||
|
||||
@ -148,9 +144,7 @@ sub unload {
|
||||
# disconnected with 'excess flood'). this event handler resumes the game once
|
||||
# the boards have finished transmitting, unless the game was manually paused
|
||||
# by a player.
|
||||
sub on_output_queue_empty {
|
||||
my ($self) = @_; # we don't care about the other event arguments
|
||||
|
||||
sub on_output_queue_empty($self, $event_type, $event) {
|
||||
# if we're paused waiting for the output queue, go ahead and unpause
|
||||
if ($self->{state_data}->{paused} == $self->{PAUSED_FOR_OUTPUT_QUEUE}) {
|
||||
$self->{state_data}->{paused} = 0;
|
||||
@ -160,9 +154,7 @@ sub on_output_queue_empty {
|
||||
}
|
||||
|
||||
# `battleship` bot command
|
||||
sub cmd_battleship {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_battleship($self, $context) {
|
||||
my $usage = "Usage: battleship challenge|accept|decline|ready|unready|bomb|board|score|players|pause|quit|kick|abort; see also: battleship help <command>";
|
||||
|
||||
# strip leading and trailing whitespace
|
||||
@ -485,11 +477,7 @@ sub cmd_battleship {
|
||||
}
|
||||
|
||||
# add a message to PBot output queue, optionally with a delay
|
||||
sub send_message {
|
||||
my ($self, $to, $text, $delay) = @_;
|
||||
|
||||
$delay //= 0;
|
||||
|
||||
sub send_message($self, $to, $text, $delay = 0) {
|
||||
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
|
||||
|
||||
my $message = {
|
||||
@ -506,16 +494,13 @@ sub send_message {
|
||||
}
|
||||
|
||||
# get unambiguous internal id for player hostmask
|
||||
sub get_player_id {
|
||||
my ($self, $nick, $user, $host) = @_;
|
||||
sub get_player_id($self, $nick, $user, $host) {
|
||||
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
||||
return $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($id);
|
||||
}
|
||||
|
||||
# create a new player hash
|
||||
sub new_player {
|
||||
my ($self, $id, $nick) = @_;
|
||||
|
||||
sub new_player($self, $id, $nick) {
|
||||
return {
|
||||
id => $id,
|
||||
name => $nick,
|
||||
@ -533,15 +518,13 @@ sub new_player {
|
||||
}
|
||||
|
||||
# get a random number interval [lower, upper)
|
||||
sub number {
|
||||
my ($self, $lower, $upper) = @_;
|
||||
sub number($self, $lower, $upper) {
|
||||
return int rand($upper - $lower) + $lower;
|
||||
}
|
||||
|
||||
# battleship stuff
|
||||
|
||||
sub begin_game_loop {
|
||||
my ($self) = @_;
|
||||
sub begin_game_loop($self) {
|
||||
# add `battleship loop` event repeating at 1s interval
|
||||
$self->{pbot}->{event_queue}->enqueue_event(
|
||||
sub {
|
||||
@ -551,8 +534,7 @@ sub begin_game_loop {
|
||||
);
|
||||
}
|
||||
|
||||
sub end_game_loop {
|
||||
my ($self) = @_;
|
||||
sub end_game_loop($self) {
|
||||
# remove `battleship loop` event
|
||||
|
||||
# repeating events get added back to event queue if we attempt to
|
||||
@ -564,9 +546,7 @@ sub end_game_loop {
|
||||
$self->{pbot}->{event_queue}->dequeue_event('battleship loop', 0);
|
||||
}
|
||||
|
||||
sub init_game {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub init_game($self, $state) {
|
||||
# default board dimensions
|
||||
$self->{N_X} = $self->{BOARD_X};
|
||||
$self->{N_Y} = $self->{BOARD_Y};
|
||||
@ -596,9 +576,7 @@ sub init_game {
|
||||
}
|
||||
|
||||
# ensures a ship can be placed at this location (all desired tiles are ocean)
|
||||
sub check_ship_placement {
|
||||
my ($self, $x, $y, $o, $l) = @_;
|
||||
|
||||
sub check_ship_placement($self, $x, $y, $o, $l) {
|
||||
my ($xd, $yd, $i);
|
||||
|
||||
if ($o == $self->{ORIENT_VERT}) {
|
||||
@ -625,9 +603,7 @@ sub check_ship_placement {
|
||||
}
|
||||
|
||||
# attempt to place a ship on the battlefield
|
||||
sub place_ship {
|
||||
my ($self, $player_id, $player_index, $ship) = @_;
|
||||
|
||||
sub place_ship($self, $player_id, $player_index, $ship) {
|
||||
my ($x, $y, $o, $i, $l);
|
||||
my ($yd, $xd) = (0, 0);
|
||||
|
||||
@ -702,9 +678,7 @@ sub place_ship {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub place_whirlpool {
|
||||
my ($self) = @_;
|
||||
|
||||
sub place_whirlpool($self) {
|
||||
for (my $attempt = 0; $attempt < 1000; $attempt++) {
|
||||
my $x = $self->number(0, $self->{N_X});
|
||||
my $y = $self->number(0, $self->{N_Y});
|
||||
@ -724,9 +698,7 @@ sub place_whirlpool {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub generate_battlefield {
|
||||
my ($self) = @_;
|
||||
|
||||
sub generate_battlefield($self) {
|
||||
# fill board with ocean
|
||||
for (my $x = 0; $x < $self->{N_X}; $x++) {
|
||||
for (my $y = 0; $y < $self->{N_Y}; $y++) {
|
||||
@ -760,9 +732,7 @@ sub generate_battlefield {
|
||||
}
|
||||
|
||||
# we hit a ship; check if the ship has sunk
|
||||
sub check_sunk {
|
||||
my ($self, $x, $y) = @_;
|
||||
|
||||
sub check_sunk($self, $x, $y) {
|
||||
# alias to the tile we hit
|
||||
my $tile = $self->{board}->[$x][$y];
|
||||
|
||||
@ -791,9 +761,7 @@ sub check_sunk {
|
||||
}
|
||||
}
|
||||
|
||||
sub get_attack_text {
|
||||
my ($self) = @_;
|
||||
|
||||
sub get_attack_text($self) {
|
||||
my @attacks = (
|
||||
"launches torpedoes at",
|
||||
"launches nukes at",
|
||||
@ -810,9 +778,7 @@ sub get_attack_text {
|
||||
|
||||
# checks if we hit whirlpool, ocean, ship, etc
|
||||
# reveals struck whirlpools
|
||||
sub check_hit {
|
||||
my ($self, $state, $player, $location_data) = @_;
|
||||
|
||||
sub check_hit($self, $state, $player, $location_data) {
|
||||
my ($x, $y, $location) = (
|
||||
$location_data->{x},
|
||||
$location_data->{y},
|
||||
@ -874,9 +840,7 @@ sub check_hit {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub perform_attack {
|
||||
my ($self, $state, $player) = @_;
|
||||
|
||||
sub perform_attack($self, $state, $player) {
|
||||
$player->{shots}++;
|
||||
|
||||
# random attack verb
|
||||
@ -975,9 +939,7 @@ sub perform_attack {
|
||||
}
|
||||
}
|
||||
|
||||
sub list_players {
|
||||
my ($self) = @_;
|
||||
|
||||
sub list_players($self) {
|
||||
my @players;
|
||||
|
||||
foreach my $player (@{$self->{state_data}->{players}}) {
|
||||
@ -989,9 +951,7 @@ sub list_players {
|
||||
}
|
||||
}
|
||||
|
||||
sub show_scoreboard {
|
||||
my ($self) = @_;
|
||||
|
||||
sub show_scoreboard($self) {
|
||||
foreach my $player (sort { $b->{health} <=> $a->{health} } @{$self->{state_data}->{players}}) {
|
||||
next if $player->{removed};
|
||||
|
||||
@ -1010,9 +970,7 @@ sub show_scoreboard {
|
||||
}
|
||||
}
|
||||
|
||||
sub show_battlefield {
|
||||
my ($self, $player_index, $nick) = @_;
|
||||
|
||||
sub show_battlefield($self, $player_index, $nick) {
|
||||
$self->{pbot}->{logger}->log("Showing battlefield for player $player_index\n");
|
||||
|
||||
my $player;
|
||||
@ -1173,9 +1131,7 @@ sub show_battlefield {
|
||||
# game state machine stuff
|
||||
|
||||
# do one loop of the game engine
|
||||
sub run_one_state {
|
||||
my ($self) = @_;
|
||||
|
||||
sub run_one_state($self) {
|
||||
# don't run a game loop if we're paused
|
||||
if ($self->{state_data}->{paused}) {
|
||||
return;
|
||||
@ -1243,17 +1199,14 @@ sub run_one_state {
|
||||
}
|
||||
|
||||
# skip directly to a state
|
||||
sub set_state {
|
||||
my ($self, $newstate) = @_;
|
||||
sub set_state($self, $newstate) {
|
||||
$self->{previous_state} = $self->{current_state};
|
||||
$self->{current_state} = $newstate;
|
||||
$self->{state_data}->{ticks} = 0;
|
||||
}
|
||||
|
||||
# set up game state machine
|
||||
sub create_states {
|
||||
my ($self) = @_;
|
||||
|
||||
sub create_states($self) {
|
||||
$self->{pbot}->{logger}->log("Battleship: Creating game state machine\n");
|
||||
|
||||
# initialize default state
|
||||
@ -1321,15 +1274,12 @@ sub create_states {
|
||||
|
||||
# game states
|
||||
|
||||
sub state_nogame {
|
||||
my ($self, $state) = @_;
|
||||
sub state_nogame($self, $state) {
|
||||
$self->end_game_loop;
|
||||
$state->{trans} = 'nogame';
|
||||
}
|
||||
|
||||
sub state_challenge {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub state_challenge($self, $state) {
|
||||
# max number of times to perform tock action
|
||||
$state->{tock_limit} = 5;
|
||||
|
||||
@ -1378,9 +1328,7 @@ sub state_challenge {
|
||||
}
|
||||
}
|
||||
|
||||
sub state_genboard {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub state_genboard($self, $state) {
|
||||
if (!$self->init_game($state)) {
|
||||
$self->{pbot}->{logger}->log("Failed to generate battlefield\n");
|
||||
$self->send_message($self->{channel}, "Failed to generate a suitable battlefield. Please try again.");
|
||||
@ -1391,9 +1339,7 @@ sub state_genboard {
|
||||
}
|
||||
}
|
||||
|
||||
sub state_showboard {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub state_showboard($self, $state) {
|
||||
# pause the game to send the boards to all the players.
|
||||
# this is due to output pacing; the messages are trickled out slowly
|
||||
# to avoid overflowing the ircd's receive queue. we do not want the
|
||||
@ -1411,9 +1357,7 @@ sub state_showboard {
|
||||
$state->{trans} = 'next';
|
||||
}
|
||||
|
||||
sub state_move {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub state_move($self, $state) {
|
||||
# allow 5 tocks before players have missed their move
|
||||
$state->{tock_limit} = 5;
|
||||
|
||||
@ -1493,9 +1437,7 @@ sub state_move {
|
||||
$state->{trans} = 'wait';
|
||||
}
|
||||
|
||||
sub state_attack {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub state_attack($self, $state) {
|
||||
my $trans = 'next';
|
||||
|
||||
foreach my $player (@{$state->{players}}) {
|
||||
@ -1515,9 +1457,7 @@ sub state_attack {
|
||||
$state->{trans} = $trans;
|
||||
}
|
||||
|
||||
sub state_gameover {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub state_gameover($self, $state) {
|
||||
if (@{$state->{players}} >= 2) {
|
||||
$self->show_battlefield($self->{BOARD_FINAL});
|
||||
$self->show_scoreboard;
|
||||
|
||||
@ -20,9 +20,7 @@ $Data::Dumper::Sortkeys = 1;
|
||||
|
||||
# This plugin was contributed by mannito, based on an earlier version of Battleship.pm
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'connect4',
|
||||
help => 'Connect-4 board game',
|
||||
@ -38,8 +36,7 @@ sub initialize {
|
||||
$self->create_states;
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('connect4');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.part');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.quit');
|
||||
@ -47,8 +44,7 @@ sub unload {
|
||||
$self->{pbot}->{event_queue}->dequeue_event('connect4 loop');
|
||||
}
|
||||
|
||||
sub on_kick {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_kick($self, $event_type, $event) {
|
||||
my ($nick, $user, $host) = ($event->nick, $event->user, $event->host);
|
||||
my ($victim, $reason) = ($event->to, $event->{args}[1]);
|
||||
my $channel = $event->{args}[0];
|
||||
@ -57,8 +53,7 @@ sub on_kick {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_departure {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_departure($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $channel) = ($event->nick, $event->user, $event->host, $event->to);
|
||||
my $type = uc $event->type;
|
||||
return 0 if $type ne 'QUIT' and lc $channel ne $self->{channel};
|
||||
@ -99,8 +94,7 @@ my $MAX_NX = 80;
|
||||
my $MAX_NY = 12;
|
||||
|
||||
# challenge options: CONNS:ROWSxCOLS
|
||||
sub parse_challenge {
|
||||
my ($self, $options) = @_;
|
||||
sub parse_challenge($self, $options) {
|
||||
my ($conns, $xy, $nx, $ny);
|
||||
|
||||
"x" =~ /x/; # clear $1, $2 ...
|
||||
@ -132,16 +126,18 @@ sub parse_challenge {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub cmd_connect4 {
|
||||
my ($self, $context) = @_;
|
||||
my $err;
|
||||
|
||||
sub cmd_connect4($self, $context) {
|
||||
$context->{arguments} =~ s/^\s+|\s+$//g;
|
||||
|
||||
my $usage = "Usage: connect4 challenge|accept|play|board|quit|players|kick|abort; for more information about a command: connect4 help <command>";
|
||||
|
||||
my ($command, $arguments, $options) = split / /, $context->{arguments}, 3;
|
||||
$command = lc $command;
|
||||
|
||||
if (defined $command) {
|
||||
$command = lc $command;
|
||||
} else {
|
||||
$command = '';
|
||||
}
|
||||
|
||||
given ($command) {
|
||||
when ('help') {
|
||||
@ -164,6 +160,8 @@ sub cmd_connect4 {
|
||||
$self->{N_Y} = $DEFAULT_NY;
|
||||
$self->{CONNECTIONS} = $DEFAULT_CONNECTIONS;
|
||||
|
||||
my $err;
|
||||
|
||||
if ((not length $arguments) || ($arguments =~ m/^\d+.*$/ && not($err = $self->parse_challenge($arguments)))) {
|
||||
$self->{current_state} = 'accept';
|
||||
$self->{state_data} = {players => [], counter => 0};
|
||||
@ -351,9 +349,7 @@ sub cmd_connect4 {
|
||||
return "";
|
||||
}
|
||||
|
||||
sub player_left {
|
||||
my ($self, $nick, $user, $host) = @_;
|
||||
|
||||
sub player_left($self, $nick, $user, $host) {
|
||||
my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host);
|
||||
my $removed = 0;
|
||||
|
||||
@ -371,8 +367,7 @@ sub player_left {
|
||||
}
|
||||
}
|
||||
|
||||
sub send_message {
|
||||
my ($self, $to, $text, $delay) = @_;
|
||||
sub send_message($self, $to, $text, $delay) {
|
||||
$delay = 0 if not defined $delay;
|
||||
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
|
||||
my $message = {
|
||||
@ -387,9 +382,7 @@ sub send_message {
|
||||
$self->{pbot}->{interpreter}->add_message_to_output_queue($to, $message, $delay);
|
||||
}
|
||||
|
||||
sub run_one_state {
|
||||
my $self = shift;
|
||||
|
||||
sub run_one_state($self) {
|
||||
# check for naughty or missing players
|
||||
if ($self->{current_state} =~ /(?:move|accept)/) {
|
||||
my $removed = 0;
|
||||
@ -461,9 +454,7 @@ sub run_one_state {
|
||||
$self->{state_data}->{ticks}++;
|
||||
}
|
||||
|
||||
sub create_states {
|
||||
my $self = shift;
|
||||
|
||||
sub create_states($self) {
|
||||
$self->{pbot}->{logger}->log("Connect4: Creating game state machine\n");
|
||||
|
||||
$self->{previous_state} = '';
|
||||
@ -502,9 +493,7 @@ sub create_states {
|
||||
|
||||
# connect4 stuff
|
||||
|
||||
sub init_game {
|
||||
my ($self, $nick1, $nick2) = @_;
|
||||
|
||||
sub init_game($self, $nick1, $nick2) {
|
||||
$self->{chips} = 0;
|
||||
$self->{draw} = 0;
|
||||
|
||||
@ -522,8 +511,7 @@ sub init_game {
|
||||
$self->generate_board;
|
||||
}
|
||||
|
||||
sub generate_board {
|
||||
my ($self) = @_;
|
||||
sub generate_board($self) {
|
||||
my ($x, $y);
|
||||
|
||||
for ($y = 0; $y < $self->{N_Y}; $y++) {
|
||||
@ -531,8 +519,7 @@ sub generate_board {
|
||||
}
|
||||
}
|
||||
|
||||
sub check_one {
|
||||
my ($self, $y, $x, $prev) = @_;
|
||||
sub check_one($self, $y, $x, $prev) {
|
||||
my $chip = $self->{board}[$y][$x];
|
||||
|
||||
push @{$self->{winner_line}}, "$y $x";
|
||||
@ -542,8 +529,7 @@ sub check_one {
|
||||
return (scalar @{$self->{winner_line}} == $self->{CONNECTIONS}, $chip);
|
||||
}
|
||||
|
||||
sub connected {
|
||||
my ($self) = @_;
|
||||
sub connected($self) {
|
||||
my ($i, $j, $row, $col, $prev) = (0, 0, 0, 0, 0);
|
||||
my $rv;
|
||||
|
||||
@ -605,8 +591,7 @@ sub connected {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub column_top {
|
||||
my ($self, $x) = @_;
|
||||
sub column_top($self, $x) {
|
||||
my $y;
|
||||
|
||||
for ($y = 0; $y < $self->{N_Y}; $y++) {
|
||||
@ -615,8 +600,7 @@ sub column_top {
|
||||
return -1; # shouldnt happen
|
||||
}
|
||||
|
||||
sub play {
|
||||
my ($self, $player, $location) = @_;
|
||||
sub play($self, $player, $location) {
|
||||
my ($draw, $c4, $x, $y);
|
||||
|
||||
$x = $location - 1;
|
||||
@ -652,8 +636,7 @@ sub play {
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub show_board {
|
||||
my ($self) = @_;
|
||||
sub show_board($self) {
|
||||
my ($x, $y, $buf, $chip, $c);
|
||||
|
||||
$self->{pbot}->{logger}->log("showing board\n");
|
||||
@ -683,9 +666,11 @@ sub show_board {
|
||||
for ($y = 0; $y < $self->{N_Y}; $y++) {
|
||||
for ($x = 0; $x < $self->{N_X}; $x++) {
|
||||
$chip = $self->{board}->[$y][$x];
|
||||
|
||||
my $rc = "$y $x";
|
||||
|
||||
$c = $chip eq 'O' ? $color{red} : $color{yellow};
|
||||
|
||||
if (grep(/^$rc$/, @{$self->{winner_line}})) { $c .= $color{bold}; }
|
||||
|
||||
$buf .= $color{blue} . "[";
|
||||
@ -702,16 +687,13 @@ sub show_board {
|
||||
|
||||
# state subroutines
|
||||
|
||||
sub nogame {
|
||||
my ($self, $state) = @_;
|
||||
sub nogame($self, $state) {
|
||||
$state->{result} = 'nogame';
|
||||
$self->{pbot}->{event_queue}->update_repeating('connect4 loop', 0);
|
||||
return $state;
|
||||
}
|
||||
|
||||
sub accept {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub accept($self, $state) {
|
||||
$state->{max_count} = 3;
|
||||
|
||||
if ($state->{players}->[1]->{accepted}) {
|
||||
@ -743,16 +725,14 @@ sub accept {
|
||||
return $state;
|
||||
}
|
||||
|
||||
sub genboard {
|
||||
my ($self, $state) = @_;
|
||||
sub genboard($self, $state) {
|
||||
$self->init_game($state->{players}->[0]->{name}, $state->{players}->[1]->{name});
|
||||
$state->{max_count} = 3;
|
||||
$state->{result} = 'next';
|
||||
$state->{result} = 'next';
|
||||
return $state;
|
||||
}
|
||||
|
||||
sub showboard {
|
||||
my ($self, $state) = @_;
|
||||
sub showboard($self, $state) {
|
||||
$self->send_message($self->{channel}, "Showing board ...");
|
||||
$self->show_board;
|
||||
$self->send_message($self->{channel}, "Fight! Anybody (players and spectators) can use `board` at any time to see latest version of the board!");
|
||||
@ -760,12 +740,14 @@ sub showboard {
|
||||
return $state;
|
||||
}
|
||||
|
||||
sub playermove {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
sub playermove($self, $state) {
|
||||
my $tock;
|
||||
if ($state->{first_tock}) { $tock = 3; }
|
||||
else { $tock = 15; }
|
||||
|
||||
if ($state->{first_tock}) {
|
||||
$tock = 3;
|
||||
} else {
|
||||
$tock = 15;
|
||||
}
|
||||
|
||||
if ($self->{player}->[$state->{current_player}]->{done}) {
|
||||
$self->{pbot}->{logger}->log("playermove: player $state->{current_player} done, nexting\n");
|
||||
@ -780,8 +762,8 @@ sub playermove {
|
||||
$self->send_message($self->{channel}, "$state->{players}->[$state->{current_player}]->{name} failed to play in time. They forfeit their turn!");
|
||||
$self->{player}->[$state->{current_player}]->{done} = 1;
|
||||
$self->{player}->[!$state->{current_player}]->{done} = 0;
|
||||
$state->{current_player} = !$state->{current_player};
|
||||
$state->{result} = 'next';
|
||||
$state->{current_player} = !$state->{current_player};
|
||||
$state->{result} = 'next';
|
||||
return $state;
|
||||
}
|
||||
|
||||
@ -798,20 +780,18 @@ sub playermove {
|
||||
return $state;
|
||||
}
|
||||
|
||||
sub checkplayer {
|
||||
my ($self, $state) = @_;
|
||||
|
||||
if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) { $state->{result} = 'end'; }
|
||||
else { $state->{result} = 'next'; }
|
||||
sub checkplayer($self, $state) {
|
||||
if ($self->{player}->[$state->{current_player}]->{won} || $self->{draw}) {
|
||||
$state->{result} = 'end';
|
||||
} else {
|
||||
$state->{result} = 'next';
|
||||
}
|
||||
return $state;
|
||||
}
|
||||
|
||||
sub gameover {
|
||||
my ($self, $state) = @_;
|
||||
my $buf;
|
||||
sub gameover($self, $state) {
|
||||
if ($state->{ticks} % 2 == 0) {
|
||||
$self->show_board;
|
||||
$self->send_message($self->{channel}, $buf);
|
||||
$self->send_message($self->{channel}, "Game over!");
|
||||
$state->{players} = [];
|
||||
$state->{counter} = 0;
|
||||
|
||||
@ -15,8 +15,7 @@ use DBI;
|
||||
use Time::Duration qw/duration/;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->register(sub { $self->cmd_counteradd(@_) }, 'counteradd', 0);
|
||||
$self->{pbot}->{commands}->register(sub { $self->cmd_counterdel(@_) }, 'counterdel', 0);
|
||||
$self->{pbot}->{commands}->register(sub { $self->cmd_counterreset(@_) }, 'counterreset', 0);
|
||||
@ -31,8 +30,7 @@ sub initialize {
|
||||
$self->create_database;
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->unregister('counteradd');
|
||||
$self->{pbot}->{commands}->unregister('counterdel');
|
||||
$self->{pbot}->{commands}->unregister('counterreset');
|
||||
@ -43,9 +41,7 @@ sub unload {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
}
|
||||
|
||||
sub create_database {
|
||||
my $self = shift;
|
||||
|
||||
sub create_database($self) {
|
||||
eval {
|
||||
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1})
|
||||
or die $DBI::errstr;
|
||||
@ -76,8 +72,7 @@ SQL
|
||||
$self->{pbot}->{logger}->log("Counter create database failed: $@") if $@;
|
||||
}
|
||||
|
||||
sub dbi_begin {
|
||||
my ($self) = @_;
|
||||
sub dbi_begin($self) {
|
||||
eval { $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1}) or die $DBI::errstr; };
|
||||
|
||||
if ($@) {
|
||||
@ -88,27 +83,26 @@ sub dbi_begin {
|
||||
}
|
||||
}
|
||||
|
||||
sub dbi_end {
|
||||
my ($self) = @_;
|
||||
sub dbi_end($self) {
|
||||
$self->{dbh}->disconnect;
|
||||
}
|
||||
|
||||
sub add_counter {
|
||||
my ($self, $owner, $channel, $name, $description) = @_;
|
||||
|
||||
sub add_counter($self, $owner, $channel, $name, $description) {
|
||||
my ($desc, $timestamp) = $self->get_counter($channel, $name);
|
||||
|
||||
if (defined $desc) { return 0; }
|
||||
|
||||
eval {
|
||||
my $sth = $self->{dbh}->prepare('INSERT INTO Counters (channel, name, description, timestamp, created_on, created_by, counter) VALUES (?, ?, ?, ?, ?, ?, ?)');
|
||||
$sth->bind_param(1, lc $channel);
|
||||
$sth->bind_param(2, lc $name);
|
||||
$sth->bind_param(3, $description);
|
||||
$sth->bind_param(4, scalar gettimeofday);
|
||||
$sth->bind_param(5, scalar gettimeofday);
|
||||
$sth->bind_param(6, $owner);
|
||||
$sth->bind_param(7, 0);
|
||||
$sth->execute();
|
||||
$sth->execute(
|
||||
lc $channel,
|
||||
lc $name,
|
||||
$description,
|
||||
scalar gettimeofday,
|
||||
scalar gettimeofday,
|
||||
$owner,
|
||||
0,
|
||||
);
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
@ -118,9 +112,7 @@ sub add_counter {
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub reset_counter {
|
||||
my ($self, $channel, $name) = @_;
|
||||
|
||||
sub reset_counter($self, $channel, $name) {
|
||||
my ($description, $timestamp, $counter) = $self->get_counter($channel, $name);
|
||||
if (not defined $description) { return (undef, undef); }
|
||||
|
||||
@ -140,9 +132,7 @@ sub reset_counter {
|
||||
return ($description, $timestamp);
|
||||
}
|
||||
|
||||
sub delete_counter {
|
||||
my ($self, $channel, $name) = @_;
|
||||
|
||||
sub delete_counter($self, $channel, $name) {
|
||||
my ($description, $timestamp) = $self->get_counter($channel, $name);
|
||||
if (not defined $description) { return 0; }
|
||||
|
||||
@ -160,9 +150,7 @@ sub delete_counter {
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub list_counters {
|
||||
my ($self, $channel) = @_;
|
||||
|
||||
sub list_counters($self, $channel) {
|
||||
my $counters = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT name FROM Counters WHERE channel = ?');
|
||||
$sth->bind_param(1, lc $channel);
|
||||
@ -174,9 +162,7 @@ sub list_counters {
|
||||
return map { $_->[0] } @$counters;
|
||||
}
|
||||
|
||||
sub get_counter {
|
||||
my ($self, $channel, $name) = @_;
|
||||
|
||||
sub get_counter($self, $channel, $name) {
|
||||
my ($description, $time, $counter, $created_on, $created_by) = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT description, timestamp, counter, created_on, created_by FROM Counters WHERE channel = ? AND name = ?');
|
||||
$sth->bind_param(1, lc $channel);
|
||||
@ -193,9 +179,7 @@ sub get_counter {
|
||||
return ($description, $time, $counter, $created_on, $created_by);
|
||||
}
|
||||
|
||||
sub add_trigger {
|
||||
my ($self, $channel, $trigger, $target) = @_;
|
||||
|
||||
sub add_trigger($self, $channel, $trigger, $target) {
|
||||
my $exists = $self->get_trigger($channel, $trigger);
|
||||
if (defined $exists) { return 0; }
|
||||
|
||||
@ -214,9 +198,7 @@ sub add_trigger {
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub delete_trigger {
|
||||
my ($self, $channel, $trigger) = @_;
|
||||
|
||||
sub delete_trigger($self, $channel, $trigger) {
|
||||
my $target = $self->get_trigger($channel, $trigger);
|
||||
if (not defined $target) { return 0; }
|
||||
|
||||
@ -227,9 +209,7 @@ sub delete_trigger {
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub list_triggers {
|
||||
my ($self, $channel) = @_;
|
||||
|
||||
sub list_triggers($self, $channel) {
|
||||
my $triggers = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT trigger, target FROM Triggers WHERE channel = ?');
|
||||
$sth->bind_param(1, lc $channel);
|
||||
@ -241,9 +221,7 @@ sub list_triggers {
|
||||
return @$triggers;
|
||||
}
|
||||
|
||||
sub get_trigger {
|
||||
my ($self, $channel, $trigger) = @_;
|
||||
|
||||
sub get_trigger($self, $channel, $trigger) {
|
||||
my $target = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT target FROM Triggers WHERE channel = ? AND trigger = ?');
|
||||
$sth->bind_param(1, lc $channel);
|
||||
@ -260,8 +238,7 @@ sub get_trigger {
|
||||
return $target;
|
||||
}
|
||||
|
||||
sub cmd_counteradd {
|
||||
my ($self, $context) = @_;
|
||||
sub cmd_counteradd($self, $context) {
|
||||
return "Internal error." if not $self->dbi_begin;
|
||||
my ($channel, $name, $description);
|
||||
|
||||
@ -273,24 +250,31 @@ sub cmd_counteradd {
|
||||
} else {
|
||||
$channel = $context->{from};
|
||||
($name, $description) = split /\s+/, $context->{arguments}, 2;
|
||||
if (not defined $name or not defined $description) { return "Usage: counteradd <name> <description>"; }
|
||||
if (not defined $name or not defined $description) {
|
||||
return "Usage: counteradd <name> <description>";
|
||||
}
|
||||
}
|
||||
|
||||
my $result;
|
||||
if ($self->add_counter($context->{hostmask}, $channel, $name, $description)) { $result = "Counter added."; }
|
||||
else { $result = "Counter '$name' already exists."; }
|
||||
if ($self->add_counter($context->{hostmask}, $channel, $name, $description)) {
|
||||
$result = "Counter added.";
|
||||
} else {
|
||||
$result = "Counter '$name' already exists.";
|
||||
}
|
||||
|
||||
$self->dbi_end;
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub cmd_counterdel {
|
||||
my ($self, $context) = @_;
|
||||
sub cmd_counterdel($self, $context) {
|
||||
return "Internal error." if not $self->dbi_begin;
|
||||
my ($channel, $name);
|
||||
|
||||
if ($context->{from} !~ m/^#/) {
|
||||
($channel, $name) = split /\s+/, $context->{arguments}, 2;
|
||||
if (not defined $channel or not defined $name or $channel !~ m/^#/) { return "Usage from private message: counterdel <channel> <name>"; }
|
||||
if (not defined $channel or not defined $name or $channel !~ m/^#/) {
|
||||
return "Usage from private message: counterdel <channel> <name>";
|
||||
}
|
||||
} else {
|
||||
$channel = $context->{from};
|
||||
($name) = split /\s+/, $context->{arguments}, 1;
|
||||
@ -298,20 +282,25 @@ sub cmd_counterdel {
|
||||
}
|
||||
|
||||
my $result;
|
||||
if ($self->delete_counter($channel, $name)) { $result = "Counter removed."; }
|
||||
else { $result = "No such counter."; }
|
||||
if ($self->delete_counter($channel, $name)) {
|
||||
$result = "Counter removed.";
|
||||
} else {
|
||||
$result = "No such counter.";
|
||||
}
|
||||
|
||||
$self->dbi_end;
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub cmd_counterreset {
|
||||
my ($self, $context) = @_;
|
||||
sub cmd_counterreset($self, $context) {
|
||||
return "Internal error." if not $self->dbi_begin;
|
||||
my ($channel, $name);
|
||||
|
||||
if ($context->{from} !~ m/^#/) {
|
||||
($channel, $name) = split /\s+/, $context->{arguments}, 2;
|
||||
if (not defined $channel or not defined $name or $channel !~ m/^#/) { return "Usage from private message: counterreset <channel> <name>"; }
|
||||
if (not defined $channel or not defined $name or $channel !~ m/^#/) {
|
||||
return "Usage from private message: counterreset <channel> <name>";
|
||||
}
|
||||
} else {
|
||||
$channel = $context->{from};
|
||||
($name) = split /\s+/, $context->{arguments}, 1;
|
||||
@ -331,14 +320,15 @@ sub cmd_counterreset {
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub cmd_countershow {
|
||||
my ($self, $context) = @_;
|
||||
sub cmd_countershow($self, $context) {
|
||||
return "Internal error." if not $self->dbi_begin;
|
||||
my ($channel, $name);
|
||||
|
||||
if ($context->{from} !~ m/^#/) {
|
||||
($channel, $name) = split /\s+/, $context->{arguments}, 2;
|
||||
if (not defined $channel or not defined $name or $channel !~ m/^#/) { return "Usage from private message: countershow <channel> <name>"; }
|
||||
if (not defined $channel or not defined $name or $channel !~ m/^#/) {
|
||||
return "Usage from private message: countershow <channel> <name>";
|
||||
}
|
||||
} else {
|
||||
$channel = $context->{from};
|
||||
($name) = split /\s+/, $context->{arguments}, 1;
|
||||
@ -350,7 +340,7 @@ sub cmd_countershow {
|
||||
if (defined $description) {
|
||||
my $ago = duration gettimeofday - $timestamp;
|
||||
$created_on = duration gettimeofday - $created_on;
|
||||
$result = "It has been $ago since $description. It has been reset $counter time" . ($counter == 1 ? '' : 's') . " since its creation $created_on ago.";
|
||||
$result = "It has been $ago since $description. It has been reset $counter time" . ($counter == 1 ? '' : 's') . " since its creation $created_on ago.";
|
||||
} else {
|
||||
$result = "No such counter.";
|
||||
}
|
||||
@ -359,13 +349,15 @@ sub cmd_countershow {
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub cmd_counterlist {
|
||||
my ($self, $context) = @_;
|
||||
sub cmd_counterlist($self, $context) {
|
||||
return "Internal error." if not $self->dbi_begin;
|
||||
my $channel;
|
||||
|
||||
if ($context->{from} !~ m/^#/) {
|
||||
if (not length $context->{arguments} or $context->{arguments} !~ m/^#/) { return "Usage from private message: counterlist <channel>"; }
|
||||
if (not length $context->{arguments} or $context->{arguments} !~ m/^#/) {
|
||||
return "Usage from private message: counterlist <channel>";
|
||||
}
|
||||
|
||||
$channel = $context->{arguments};
|
||||
} else {
|
||||
$channel = $context->{from};
|
||||
@ -388,8 +380,7 @@ sub cmd_counterlist {
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub cmd_countertrigger {
|
||||
my ($self, $context) = @_;
|
||||
sub cmd_countertrigger($self, $context) {
|
||||
return "Internal error." if not $self->dbi_begin;
|
||||
my $command;
|
||||
($command, $context->{arguments}) = split / /, $context->{arguments}, 2;
|
||||
@ -398,9 +389,11 @@ sub cmd_countertrigger {
|
||||
|
||||
given ($command) {
|
||||
when ('list') {
|
||||
if ($context->{from} =~ m/^#/) { $channel = $context->{from}; }
|
||||
else {
|
||||
if ($context->{from} =~ m/^#/) {
|
||||
$channel = $context->{from};
|
||||
} else {
|
||||
($channel) = split / /, $context->{arguments}, 1;
|
||||
|
||||
if ($channel !~ m/^#/) {
|
||||
$self->dbi_end;
|
||||
return "Usage from private message: countertrigger list <channel>";
|
||||
@ -433,8 +426,12 @@ sub cmd_countertrigger {
|
||||
my ($trigger, $target) = split / /, $context->{arguments}, 2;
|
||||
|
||||
if (not defined $trigger or not defined $target) {
|
||||
if ($context->{from} !~ m/^#/) { $result = "Usage from private message: countertrigger add <channel> <regex> <target>"; }
|
||||
else { $result = "Usage: countertrigger add <regex> <target>"; }
|
||||
if ($context->{from} !~ m/^#/) {
|
||||
$result = "Usage from private message: countertrigger add <channel> <regex> <target>";
|
||||
} else {
|
||||
$result = "Usage: countertrigger add <regex> <target>";
|
||||
}
|
||||
|
||||
$self->dbi_end;
|
||||
return $result;
|
||||
}
|
||||
@ -446,8 +443,11 @@ sub cmd_countertrigger {
|
||||
return "Trigger already exists.";
|
||||
}
|
||||
|
||||
if ($self->add_trigger($channel, $trigger, $target)) { $result = "Trigger added."; }
|
||||
else { $result = "Failed to add trigger."; }
|
||||
if ($self->add_trigger($channel, $trigger, $target)) {
|
||||
$result = "Trigger added.";
|
||||
} else {
|
||||
$result = "Failed to add trigger.";
|
||||
}
|
||||
}
|
||||
|
||||
when ('delete') {
|
||||
@ -485,8 +485,7 @@ sub cmd_countertrigger {
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
|
||||
my $channel = $event->{to}[0];
|
||||
|
||||
@ -506,8 +505,11 @@ sub on_public {
|
||||
eval {
|
||||
my $message;
|
||||
|
||||
if ($trigger->{trigger} =~ m/^\^/) { $message = "$hostmask $msg"; }
|
||||
else { $message = $msg; }
|
||||
if ($trigger->{trigger} =~ m/^\^/) {
|
||||
$message = "$hostmask $msg";
|
||||
} else {
|
||||
$message = $msg;
|
||||
}
|
||||
|
||||
my $silent = 0;
|
||||
|
||||
@ -527,6 +529,7 @@ sub on_public {
|
||||
|
||||
if ($@) { $self->{pbot}->{logger}->log("Skipping bad trigger $trigger->{trigger}: $@"); }
|
||||
}
|
||||
|
||||
$self->dbi_end;
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -10,9 +10,7 @@ use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
# add default registry entry for default timezone
|
||||
# this can be overridden via arguments or user metadata
|
||||
$self->{pbot}->{registry}->add_default('text', 'date', 'default_timezone', 'UTC');
|
||||
@ -25,14 +23,11 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('date');
|
||||
}
|
||||
|
||||
sub cmd_date {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_date($self, $context) {
|
||||
my $usage = "Usage: date [-u <user account>] [timezone]";
|
||||
|
||||
my %opts;
|
||||
|
||||
@ -10,24 +10,19 @@ use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{event_dispatcher}->register_handler(
|
||||
'irc.public',
|
||||
sub { $self->on_public(@_) },
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
|
||||
sub unload($self) {
|
||||
# perform plugin clean-up here
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
|
||||
@ -15,8 +15,7 @@ use PBot::Core::Utils::Indefinite;
|
||||
use Lingua::EN::Tagger;
|
||||
use URI::Escape qw/uri_escape_utf8/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{functions}->register(
|
||||
'title',
|
||||
{
|
||||
@ -85,8 +84,7 @@ sub initialize {
|
||||
$self->{tagger} = Lingua::EN::Tagger->new;
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{functions}->unregister('title');
|
||||
$self->{pbot}->{functions}->unregister('ucfirst');
|
||||
$self->{pbot}->{functions}->unregister('uc');
|
||||
@ -97,26 +95,23 @@ sub unload {
|
||||
$self->{pbot}->{functions}->unregister('maybe-the');
|
||||
}
|
||||
|
||||
sub func_unquote {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_unquote($self, @rest) {
|
||||
my $text = "@rest";
|
||||
$text =~ s/^"(.*?)(?<!\\)"$/$1/ || $text =~ s/^'(.*?)(?<!\\)'$/$1/;
|
||||
$text =~ s/(?<!\\)\\'/'/g;
|
||||
$text =~ s/(?<!\\)\\"/"/g;
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub func_title {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_title($self, @rest) {
|
||||
my $text = "@rest";
|
||||
$text = ucfirst lc $text;
|
||||
$text =~ s/ (\w)/' ' . uc $1/ge;
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub func_ucfirst {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_ucfirst($self, @rest) {
|
||||
my $text = "@rest";
|
||||
|
||||
my ($word) = $text =~ m/^\s*([^',.;: ]+)/;
|
||||
|
||||
@ -128,27 +123,23 @@ sub func_ucfirst {
|
||||
return ucfirst $text;
|
||||
}
|
||||
|
||||
sub func_uc {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_uc($self, @rest) {
|
||||
my $text = "@rest";
|
||||
return uc $text;
|
||||
}
|
||||
|
||||
sub func_lc {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_lc($self, @rest) {
|
||||
my $text = "@rest";
|
||||
return lc $text;
|
||||
}
|
||||
|
||||
sub func_uri_escape {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_uri_escape($self, @rest) {
|
||||
my $text = "@rest";
|
||||
return uri_escape_utf8($text);
|
||||
}
|
||||
|
||||
sub func_ana {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_ana($self, @rest) {
|
||||
my $text = "@rest";
|
||||
|
||||
if ($text =~ s/\b(an?)(\s+)//i) {
|
||||
my ($article, $spaces) = ($1, $2);
|
||||
@ -166,9 +157,8 @@ sub func_ana {
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub func_maybe_the {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_maybe_the($self, @rest) {
|
||||
my $text = "@rest";
|
||||
|
||||
my ($word) = $text =~ m/^\s*([^',.;: ]+)/;
|
||||
|
||||
|
||||
@ -10,8 +10,7 @@ use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{functions}->register(
|
||||
'grep',
|
||||
{
|
||||
@ -22,15 +21,12 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{functions}->unregister('grep');
|
||||
}
|
||||
|
||||
sub func_grep {
|
||||
my $self = shift @_;
|
||||
my $regex = shift @_;
|
||||
my $text = "@_";
|
||||
sub func_grep($self, $regex, @rest) {
|
||||
my $text = "@rest";
|
||||
|
||||
my $result = eval {
|
||||
my $result = '';
|
||||
|
||||
@ -10,8 +10,7 @@ use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{functions}->register(
|
||||
'sed',
|
||||
{
|
||||
@ -22,16 +21,14 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{functions}->unregister('sed');
|
||||
}
|
||||
|
||||
# near-verbatim insertion of krok's `sed` factoid
|
||||
no warnings;
|
||||
sub func_sed {
|
||||
my $self = shift;
|
||||
my $text = "@_";
|
||||
sub func_sed($self, @rest) {
|
||||
my $text = "@rest";
|
||||
|
||||
my $result = eval {
|
||||
if ($text =~ /^s(.)(.*?)(?<!\\)\1(.*?)(?<!\\)\1(\S*)\s+(.*)/p) {
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
#
|
||||
# TODO: add --useragent and --striphtml, etc, options
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::GetUrl;
|
||||
@ -14,23 +14,18 @@ use PBot::Imports;
|
||||
|
||||
use LWP::UserAgent::Paranoid;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{registry}->add_default('text', 'geturl', 'enabled', 1);
|
||||
$self->{pbot}->{registry}->add_default('text', 'geturl', 'max_size', 1024 * 1024);
|
||||
|
||||
$self->{pbot}->{commands}->register(sub { $self->cmd_geturl(@_) }, 'geturl', 0);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->unregister('geturl');
|
||||
}
|
||||
|
||||
sub cmd_geturl {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_geturl($self, $context) {
|
||||
return "Usage: geturl <url>\n" if not length $context->{arguments};
|
||||
|
||||
my $enabled = $self->{pbot}->{registry}->get_value('geturl', 'enabled');
|
||||
|
||||
@ -13,8 +13,7 @@ use PBot::Imports;
|
||||
|
||||
use Time::Duration qw/duration/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'pd',
|
||||
help => 'Simple command to test ParseDate interface',
|
||||
@ -22,13 +21,11 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('pd');
|
||||
}
|
||||
|
||||
sub cmd_parsedate {
|
||||
my ($self, $context) = @_;
|
||||
sub cmd_parsedate($self, $context) {
|
||||
my ($seconds, $error) = $self->{pbot}->{parsedate}->parsedate($context->{arguments});
|
||||
return $error if defined $error;
|
||||
return duration $seconds;
|
||||
|
||||
@ -11,9 +11,7 @@ use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
# load Plang module
|
||||
my $path = $self->{pbot}->{registry}->get_value('general', 'plang_dir') // 'Plang';
|
||||
unshift @INC, "$path/lib" if not grep { $_ eq "$path/lib" } @INC;
|
||||
@ -89,16 +87,13 @@ sub initialize {
|
||||
}
|
||||
|
||||
# runs when plugin is unloaded
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->unregister('plang');
|
||||
$self->{pbot}->{commands}->unregister('plangrepl');
|
||||
delete $INC{"Plang/Interpreter.pm"};
|
||||
}
|
||||
|
||||
sub cmd_plang {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_plang($self, $context) {
|
||||
my $usage = "Usage: plang <code>; see https://github.com/pragma-/Plang and https://github.com/pragma-/pbot/blob/master/doc/Plugins/Plang.md";
|
||||
return $usage if not length $context->{arguments};
|
||||
|
||||
@ -121,9 +116,7 @@ sub cmd_plang {
|
||||
return length $self->{output} ? $self->{output} : "No output.";
|
||||
}
|
||||
|
||||
sub cmd_plangrepl {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_plangrepl($self, $context) {
|
||||
my $usage = "Usage: plangrepl <code>; see https://github.com/pragma-/Plang and https://github.com/pragma-/pbot/blob/master/doc/Plugins/Plang.md";
|
||||
return $usage if not length $context->{arguments};
|
||||
|
||||
@ -146,8 +139,7 @@ sub cmd_plangrepl {
|
||||
}
|
||||
|
||||
# overridden `print` built-in
|
||||
sub plang_builtin_print {
|
||||
my ($self, $plang, $context, $name, $arguments) = @_;
|
||||
sub plang_builtin_print($self, $plang, $context, $name, $arguments) {
|
||||
my ($expr, $end) = ($plang->output_value($arguments->[0]), $arguments->[1]->[1]);
|
||||
$self->{output} .= "$expr$end";
|
||||
return [['TYPE', 'Null'], undef];
|
||||
@ -159,13 +151,11 @@ sub plang_validate_builtin_print {
|
||||
|
||||
# our custom PBot built-in functions for Plang
|
||||
|
||||
sub is_locked {
|
||||
my ($self, $channel, $keyword) = @_;
|
||||
sub is_locked($self, $channel, $keyword) {
|
||||
return $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, 'locked');
|
||||
}
|
||||
|
||||
sub plang_builtin_factget {
|
||||
my ($self, $plang, $context, $name, $arguments) = @_;
|
||||
sub plang_builtin_factget($self, $plang, $context, $name, $arguments) {
|
||||
my ($channel, $keyword, $meta) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]);
|
||||
my $result = $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, $meta);
|
||||
if (defined $result) {
|
||||
@ -179,8 +169,7 @@ sub plang_validate_builtin_factget {
|
||||
return [['TYPE', 'String'], ""];
|
||||
}
|
||||
|
||||
sub plang_builtin_factset {
|
||||
my ($self, $plang, $context, $name, $arguments) = @_;
|
||||
sub plang_builtin_factset($self, $plang, $context, $name, $arguments) {
|
||||
my ($channel, $keyword, $text) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]);
|
||||
die "Factoid $channel.$keyword is locked. Cannot set.\n" if $self->is_locked($channel, $keyword);
|
||||
$self->{pbot}->{factoids}->{data}->add('text', $channel, 'Plang', $keyword, $text);
|
||||
@ -191,8 +180,7 @@ sub plang_validate_builtin_factset {
|
||||
return [['TYPE', 'String'], ""];
|
||||
}
|
||||
|
||||
sub plang_builtin_factappend {
|
||||
my ($self, $plang, $context, $name, $arguments) = @_;
|
||||
sub plang_builtin_factappend($self, $plang, $context, $name, $arguments) {
|
||||
my ($channel, $keyword, $text) = ($arguments->[0]->[1], $arguments->[1]->[1], $arguments->[2]->[1]);
|
||||
die "Factoid $channel.$keyword is locked. Cannot append.\n" if $self->is_locked($channel, $keyword);
|
||||
my $action = $self->{pbot}->{factoids}->{data}->get_meta($channel, $keyword, 'action');
|
||||
@ -206,8 +194,7 @@ sub plang_validate_builtin_factappend {
|
||||
return [['TYPE', 'String'], ""];
|
||||
}
|
||||
|
||||
sub plang_builtin_userget {
|
||||
my ($self, $plang, $context, $name, $arguments) = @_;
|
||||
sub plang_builtin_userget($self, $plang, $context, $name, $arguments) {
|
||||
my ($username) = ($arguments->[0], $arguments->[1]);
|
||||
|
||||
my $user = $self->{pbot}->{users}->{storage}->get_data($username->[1]);
|
||||
|
||||
@ -23,8 +23,7 @@ use PBot::Core::Utils::ValidateString;
|
||||
|
||||
use POSIX qw(strftime);
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{filename} = $conf{quotegrabs_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.sqlite3';
|
||||
|
||||
$self->{database} = PBot::Plugin::Quotegrabs::Storage::SQLite->new(pbot => $self->{pbot}, filename => $self->{filename});
|
||||
@ -39,8 +38,7 @@ sub initialize {
|
||||
$self->{pbot}->{commands}->register(sub { $self->cmd_show_random_quotegrab(@_) }, 'rq' );
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->unregister('grab');
|
||||
$self->{pbot}->{commands}->unregister('getq');
|
||||
$self->{pbot}->{commands}->unregister('delq');
|
||||
@ -50,9 +48,7 @@ sub unload {
|
||||
|
||||
sub uniq { my %seen; grep !$seen{$_}++, @_ }
|
||||
|
||||
sub export_quotegrabs {
|
||||
my $self = shift;
|
||||
|
||||
sub export_quotegrabs($self) {
|
||||
$self->{export_path} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.html';
|
||||
|
||||
my $quotegrabs = $self->{database}->get_all_quotegrabs;
|
||||
@ -153,9 +149,7 @@ sub export_quotegrabs {
|
||||
return "$i quotegrabs exported.";
|
||||
}
|
||||
|
||||
sub cmd_grab_quotegrab {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_grab_quotegrab($self, $context) {
|
||||
if (not length $context->{arguments}) {
|
||||
return
|
||||
"Usage: grab <nick> [history [channel]] [+ <nick> [history [channel]] ...] -- where [history] is an optional regex argument; e.g., to grab a message containing 'pizza', use `grab nick pizza`; you can chain grabs with + to grab multiple messages";
|
||||
@ -264,9 +258,7 @@ sub cmd_grab_quotegrab {
|
||||
}
|
||||
}
|
||||
|
||||
sub cmd_delete_quotegrab {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_delete_quotegrab($self, $context) {
|
||||
my $quotegrab = $self->{database}->get_quotegrab($context->{arguments});
|
||||
|
||||
if (not defined $quotegrab) {
|
||||
@ -293,9 +285,7 @@ sub cmd_delete_quotegrab {
|
||||
}
|
||||
}
|
||||
|
||||
sub cmd_show_quotegrab {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_show_quotegrab($self, $context) {
|
||||
my $quotegrab = $self->{database}->get_quotegrab($context->{arguments});
|
||||
|
||||
if (not defined $quotegrab) {
|
||||
@ -316,9 +306,7 @@ sub cmd_show_quotegrab {
|
||||
}
|
||||
}
|
||||
|
||||
sub cmd_show_random_quotegrab {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_show_random_quotegrab($self, $context) {
|
||||
my $usage = 'Usage: rq [nick [channel [text]]] [-c <channel>] [-t <text>]';
|
||||
|
||||
my ($nick_search, $channel_search, $text_search);
|
||||
|
||||
@ -1,8 +1,13 @@
|
||||
# File: Hashtable.pm
|
||||
#
|
||||
# Purpose: Hashtable backend for storing and retreiving quotegrabs.
|
||||
#
|
||||
# Note: This has not been maintained since the SQLite backend was created. It
|
||||
# is strongly recommended to use the SQLite backend instead since it contains
|
||||
# several improvements such as shuffling through random quotegrabs without
|
||||
# repeats, etc.
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::Quotegrabs::Storage::Hashtable;
|
||||
@ -16,31 +21,22 @@ use Getopt::Long qw(GetOptionsFromString);
|
||||
|
||||
use POSIX qw(strftime);
|
||||
|
||||
sub new {
|
||||
if (ref($_[1]) eq 'HASH') { Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference"); }
|
||||
|
||||
my ($class, %conf) = @_;
|
||||
|
||||
sub new($class, %conf) {
|
||||
my $self = bless {}, $class;
|
||||
$self->initialize(%conf);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference in " . __FILE__);
|
||||
$self->{filename} = delete $conf{filename};
|
||||
$self->{quotegrabs} = [];
|
||||
}
|
||||
|
||||
sub begin {
|
||||
my $self = shift;
|
||||
sub begin($self) {
|
||||
$self->load_quotegrabs;
|
||||
}
|
||||
|
||||
sub end { }
|
||||
|
||||
sub load_quotegrabs {
|
||||
my $self = shift;
|
||||
my $filename;
|
||||
@ -96,37 +92,30 @@ sub save_quotegrabs {
|
||||
close(FILE);
|
||||
}
|
||||
|
||||
sub add_quotegrab {
|
||||
my ($self, $quotegrab) = @_;
|
||||
|
||||
sub add_quotegrab($self, $quotegrab) {
|
||||
push @{$self->{quotegrabs}}, $quotegrab;
|
||||
$self->save_quotegrabs();
|
||||
return $#{$self->{quotegrabs}} + 1;
|
||||
}
|
||||
|
||||
sub delete_quotegrab {
|
||||
my ($self, $id) = @_;
|
||||
|
||||
sub delete_quotegrab($self, $id) {
|
||||
if ($id < 1 || $id > $#{$self->{quotegrabs}} + 1) { return undef; }
|
||||
|
||||
splice @{$self->{quotegrabs}}, $id - 1, 1;
|
||||
|
||||
for (my $i = $id - 1; $i <= $#{$self->{quotegrabs}}; $i++) { $self->{quotegrabs}[$i]->{id}--; }
|
||||
for (my $i = $id - 1; $i <= $#{$self->{quotegrabs}}; $i++) {
|
||||
$self->{quotegrabs}[$i]->{id}--;
|
||||
}
|
||||
|
||||
$self->save_quotegrabs();
|
||||
}
|
||||
|
||||
sub get_quotegrab {
|
||||
my ($self, $id) = @_;
|
||||
|
||||
sub get_quotegrab($self, $id) {
|
||||
if ($id < 1 || $id > $#{$self->{quotegrabs}} + 1) { return undef; }
|
||||
|
||||
return $self->{quotegrabs}[$id - 1];
|
||||
}
|
||||
|
||||
sub get_random_quotegrab {
|
||||
my ($self, $nick, $channel, $text) = @_;
|
||||
|
||||
sub get_random_quotegrab($self, $nick, $channel, $text) {
|
||||
$nick = '.*' if not defined $nick;
|
||||
$channel = '.*' if not defined $channel;
|
||||
$text = '.*' if not defined $text;
|
||||
@ -153,8 +142,7 @@ sub get_random_quotegrab {
|
||||
return $quotes[int rand($#quotes + 1)];
|
||||
}
|
||||
|
||||
sub get_all_quotegrabs {
|
||||
my $self = shift;
|
||||
sub get_all_quotegrabs($self) {
|
||||
return $self->{quotegrabs};
|
||||
}
|
||||
|
||||
|
||||
@ -16,22 +16,19 @@ use PBot::Imports;
|
||||
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
|
||||
$self->{queue} = [];
|
||||
$self->{notified} = {};
|
||||
$self->{pbot}->{event_queue}->enqueue(sub { $self->check_queue }, 1, 'RelayUnreg');
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_queue}->dequeue('RelayUnreg');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
|
||||
my $channel = lc $event->{to}[0];
|
||||
|
||||
@ -90,8 +87,7 @@ sub on_public {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub check_queue {
|
||||
my $self = shift;
|
||||
sub check_queue($self) {
|
||||
my $now = gettimeofday;
|
||||
|
||||
if (@{$self->{queue}}) {
|
||||
|
||||
@ -16,9 +16,7 @@ use PBot::Imports;
|
||||
|
||||
use Storable qw/dclone/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'mod',
|
||||
help => 'Provides restricted moderation abilities to voiced users. They can kick/ban/etc only users that are not admins, whitelisted, voiced or opped.',
|
||||
@ -41,14 +39,12 @@ sub initialize {
|
||||
};
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('mod');
|
||||
$self->{pbot}->{capabilities}->remove('chanmod');
|
||||
}
|
||||
|
||||
sub help {
|
||||
my ($self, $context) = @_;
|
||||
sub help($self, $context) {
|
||||
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // 'help';
|
||||
|
||||
if (exists $self->{commands}->{$command}) {
|
||||
@ -58,14 +54,11 @@ sub help {
|
||||
}
|
||||
}
|
||||
|
||||
sub list {
|
||||
my ($self, $context) = @_;
|
||||
sub list($self, $context) {
|
||||
return "Available mod commands: " . join ', ', sort keys %{$self->{commands}};
|
||||
}
|
||||
|
||||
sub generic_command {
|
||||
my ($self, $context, $command) = @_;
|
||||
|
||||
sub generic_command($self, $context, $command) {
|
||||
my $channel = $context->{from};
|
||||
if ($channel !~ m/^#/) {
|
||||
$channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
|
||||
@ -147,41 +140,33 @@ sub generic_command {
|
||||
return "";
|
||||
}
|
||||
|
||||
sub kick {
|
||||
my ($self, $context) = @_;
|
||||
sub kick($self, $context) {
|
||||
return $self->generic_command($context, 'kick');
|
||||
}
|
||||
|
||||
sub ban {
|
||||
my ($self, $context) = @_;
|
||||
sub ban($self, $context) {
|
||||
return $self->generic_command($context, 'ban');
|
||||
}
|
||||
|
||||
sub mute {
|
||||
my ($self, $context) = @_;
|
||||
sub mute($self, $context) {
|
||||
return $self->generic_command($context, 'mute');
|
||||
}
|
||||
|
||||
sub unban {
|
||||
my ($self, $context) = @_;
|
||||
sub unban($self, $context) {
|
||||
return $self->generic_command($context, 'unban');
|
||||
}
|
||||
|
||||
sub unmute {
|
||||
my ($self, $context) = @_;
|
||||
sub unmute($self, $context) {
|
||||
return $self->generic_command($context, 'unmute');
|
||||
}
|
||||
|
||||
sub kb {
|
||||
my ($self, $context) = @_;
|
||||
sub kb($self, $context) {
|
||||
my $result = $self->ban(dclone $context); # note: using copy of $context to preserve $context->{arglist} for $self->kick($context)
|
||||
return $result if length $result;
|
||||
return $self->kick($context);
|
||||
}
|
||||
|
||||
sub cmd_mod {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_mod($self, $context) {
|
||||
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // '';
|
||||
$command = lc $command;
|
||||
|
||||
|
||||
@ -17,7 +17,7 @@
|
||||
#
|
||||
# This plugin is not in data/plugin_autoload. Load at your own risk.
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::RunCommand;
|
||||
@ -27,9 +27,7 @@ use PBot::Imports;
|
||||
|
||||
use IPC::Run qw/start pump finish/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'runcmd',
|
||||
help => 'Executes a system command and outputs each line in real-time',
|
||||
@ -38,14 +36,11 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('runcmd');
|
||||
}
|
||||
|
||||
sub cmd_runcmd {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_runcmd($self, $context) {
|
||||
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
|
||||
|
||||
my ($in, $out, $err);
|
||||
@ -71,9 +66,7 @@ sub cmd_runcmd {
|
||||
return "No output." if not $lines;
|
||||
}
|
||||
|
||||
sub send_lines {
|
||||
my ($self, $context, $buffer, $send_all) = @_;
|
||||
|
||||
sub send_lines($self, $context, $buffer, $send_all) {
|
||||
my $lines = 0;
|
||||
|
||||
my $regex;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -2,7 +2,7 @@
|
||||
#
|
||||
# Purpose: Ranks players by various keywords.
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::Spinach::Rank;
|
||||
@ -15,56 +15,47 @@ use lib "$FindBin::RealBin/../../..";
|
||||
use PBot::Plugin::Spinach::Stats;
|
||||
use Math::Expression::Evaluator;
|
||||
|
||||
sub new {
|
||||
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref $_[1] eq 'HASH';
|
||||
my ($class, %conf) = @_;
|
||||
sub new($class, %conf) {
|
||||
my $self = bless {}, $class;
|
||||
$self->initialize(%conf);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
|
||||
$self->{channel} = $conf{channel} // Carp::croak("Missing channel reference to " . __FILE__);
|
||||
$self->{filename} = $conf{filename} // 'stats.sqlite';
|
||||
$self->{stats} = PBot::Plugin::Spinach::Stats->new(pbot => $self->{pbot}, filename => $self->{filename});
|
||||
}
|
||||
|
||||
sub sort_generic {
|
||||
my ($self, $key) = @_;
|
||||
sub sort_generic($self, $key) {
|
||||
if ($self->{rank_direction} eq '+') { return $b->{$key} <=> $a->{$key}; }
|
||||
else { return $a->{$key} <=> $b->{$key}; }
|
||||
}
|
||||
|
||||
sub print_generic {
|
||||
my ($self, $key, $player) = @_;
|
||||
sub print_generic($self, $key, $player) {
|
||||
return undef if $player->{games_played} == 0;
|
||||
return "$player->{nick}: $player->{$key}";
|
||||
}
|
||||
|
||||
sub print_avg_score {
|
||||
my ($self, $player) = @_;
|
||||
sub print_avg_score($self, $player) {
|
||||
return undef if $player->{games_played} == 0;
|
||||
my $result = int $player->{avg_score};
|
||||
return "$player->{nick}: $result";
|
||||
}
|
||||
|
||||
sub sort_bad_lies {
|
||||
my ($self) = @_;
|
||||
sub sort_bad_lies($self) {
|
||||
if ($self->{rank_direction} eq '+') { return $b->{questions_played} - $b->{good_lies} <=> $a->{questions_played} - $a->{good_lies}; }
|
||||
else { return $a->{questions_played} - $a->{good_lies} <=> $b->{questions_played} - $b->{good_lies}; }
|
||||
}
|
||||
|
||||
sub print_bad_lies {
|
||||
my ($self, $player) = @_;
|
||||
sub print_bad_lies($self, $player) {
|
||||
return undef if $player->{games_played} == 0;
|
||||
my $result = $player->{questions_played} - $player->{good_lies};
|
||||
return "$player->{nick}: $result";
|
||||
}
|
||||
|
||||
sub sort_mentions {
|
||||
my ($self) = @_;
|
||||
sub sort_mentions($self) {
|
||||
if ($self->{rank_direction} eq '+') {
|
||||
return $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third} <=> $a->{games_played} - $a->{times_first} - $a->{times_second} -
|
||||
$a->{times_third};
|
||||
@ -74,16 +65,13 @@ sub sort_mentions {
|
||||
}
|
||||
}
|
||||
|
||||
sub print_mentions {
|
||||
my ($self, $player) = @_;
|
||||
sub print_mentions($self, $player) {
|
||||
return undef if $player->{games_played} == 0;
|
||||
my $result = $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third};
|
||||
return "$player->{nick}: $result";
|
||||
}
|
||||
|
||||
sub sort_expr {
|
||||
my ($self) = @_;
|
||||
|
||||
sub sort_expr($self) {
|
||||
my $result = eval {
|
||||
my $result_a = $self->{expr}->val(
|
||||
{
|
||||
@ -135,9 +123,7 @@ sub sort_expr {
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub print_expr {
|
||||
my ($self, $player) = @_;
|
||||
|
||||
sub print_expr($self, $player) {
|
||||
return undef if $player->{games_played} == 0;
|
||||
|
||||
my $result = eval {
|
||||
@ -169,9 +155,7 @@ sub print_expr {
|
||||
return "$player->{nick}: $result";
|
||||
}
|
||||
|
||||
sub rank {
|
||||
my ($self, $arguments) = @_;
|
||||
|
||||
sub rank($self, $arguments) {
|
||||
my %ranks = (
|
||||
highscore => {
|
||||
sort => sub { $self->sort_generic('high_score', @_) },
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
#
|
||||
# Purpose: Records player stats.
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::Spinach::Stats;
|
||||
@ -12,22 +12,18 @@ use PBot::Imports;
|
||||
use DBI;
|
||||
use Carp qw(shortmess);
|
||||
|
||||
sub new {
|
||||
my ($class, %conf) = @_;
|
||||
sub new($class, %conf) {
|
||||
my $self = bless {}, $class;
|
||||
$self->initialize(%conf);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
|
||||
$self->{filename} = $conf{filename} // 'stats.sqlite';
|
||||
}
|
||||
|
||||
sub begin {
|
||||
my $self = shift;
|
||||
|
||||
sub begin($self) {
|
||||
$self->{pbot}->{logger}->log("Opening Spinach stats SQLite database: $self->{filename}\n");
|
||||
|
||||
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", {RaiseError => 1, PrintError => 0}) or die $DBI::errstr;
|
||||
@ -57,9 +53,7 @@ SQL
|
||||
$self->{pbot}->{logger}->log("Error creating database: $@\n") if $@;
|
||||
}
|
||||
|
||||
sub end {
|
||||
my $self = shift;
|
||||
|
||||
sub end($self) {
|
||||
if (exists $self->{dbh} and defined $self->{dbh}) {
|
||||
$self->{pbot}->{logger}->log("Closing stats SQLite database\n");
|
||||
$self->{dbh}->disconnect();
|
||||
@ -67,9 +61,7 @@ sub end {
|
||||
}
|
||||
}
|
||||
|
||||
sub add_player {
|
||||
my ($self, $id, $nick, $channel) = @_;
|
||||
|
||||
sub add_player($self, $id, $nick, $channel) {
|
||||
eval {
|
||||
my $sth = $self->{dbh}->prepare('INSERT INTO Stats (id, nick, channel) VALUES (?, ?, ?)');
|
||||
$sth->execute($id, $nick, $channel);
|
||||
@ -83,9 +75,7 @@ sub add_player {
|
||||
return $id;
|
||||
}
|
||||
|
||||
sub get_player_id {
|
||||
my ($self, $nick, $channel, $dont_create_new) = @_;
|
||||
|
||||
sub get_player_id($self, $nick, $channel, $dont_create_new) {
|
||||
my ($account_id) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($nick);
|
||||
$account_id = $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($account_id);
|
||||
|
||||
@ -107,9 +97,7 @@ sub get_player_id {
|
||||
return $id;
|
||||
}
|
||||
|
||||
sub get_player_data {
|
||||
my ($self, $id, @columns) = @_;
|
||||
|
||||
sub get_player_data($self, $id, @columns) {
|
||||
return undef if not $id;
|
||||
|
||||
my $player_data = eval {
|
||||
@ -133,9 +121,7 @@ sub get_player_data {
|
||||
return $player_data;
|
||||
}
|
||||
|
||||
sub update_player_data {
|
||||
my ($self, $id, $data) = @_;
|
||||
|
||||
sub update_player_data($self, $id, $data) {
|
||||
eval {
|
||||
my $sql = 'UPDATE Stats SET ';
|
||||
|
||||
@ -158,9 +144,7 @@ sub update_player_data {
|
||||
print STDERR $@ if $@;
|
||||
}
|
||||
|
||||
sub get_all_players {
|
||||
my ($self, $channel) = @_;
|
||||
|
||||
sub get_all_players($self, $channel) {
|
||||
my $players = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT * FROM Stats WHERE channel = ?');
|
||||
$sth->execute($channel);
|
||||
|
||||
@ -20,21 +20,17 @@ use parent 'PBot::Plugin::Base';
|
||||
|
||||
use PBot::Imports;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public(@_) });
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_public(@_) });
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
|
||||
}
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub on_public($self, $event_type, $event) {
|
||||
my ($nick, $user, $host, $msg) = ($event->nick, $event->user, $event->host, $event->args);
|
||||
|
||||
my $channel = lc $event->{to}[0];
|
||||
|
||||
@ -17,13 +17,11 @@ use HTML::Entities;
|
||||
use JSON::XS;
|
||||
|
||||
use constant {
|
||||
TIMEOUT => 30,
|
||||
MAX_SIZE => 1024 * 800,
|
||||
TIMEOUT => 30,
|
||||
MAX_SIZE => 1024 * 800,
|
||||
};
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
# remember recent titles so we don't repeat them too often
|
||||
my $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/url-title.hist';
|
||||
|
||||
@ -43,15 +41,12 @@ sub initialize {
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->show_url_titles(@_) });
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.public');
|
||||
$self->{pbot}->{event_dispatcher}->remove_handler('irc.caction');
|
||||
}
|
||||
|
||||
sub is_ignored_url {
|
||||
my ($self, $url) = @_;
|
||||
|
||||
sub is_ignored_url($self, $url) {
|
||||
return 1 if $url =~ m{https://asciinema.org}i;
|
||||
return 1 if $url =~ m{https?://tpcg.io/}i;
|
||||
return 1 if $url =~ m/bootlin.com/i;
|
||||
@ -79,7 +74,7 @@ sub is_ignored_url {
|
||||
return 1 if $url =~ m{godbolt.org}i;
|
||||
return 1 if $url =~ m{man\.cgi}i;
|
||||
return 1 if $url =~ m{wandbox}i;
|
||||
return 1 if $url =~ m{ebay.com/itm}i;
|
||||
#return 1 if $url =~ m{ebay.com/itm}i;
|
||||
return 1 if $url =~ m/prntscr.com/i;
|
||||
return 1 if $url =~ m/imgbin.org/i;
|
||||
return 1 if $url =~ m/jsfiddle.net/i;
|
||||
@ -120,9 +115,8 @@ sub is_ignored_url {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub is_ignored_title {
|
||||
my ($self, $title) = @_;
|
||||
|
||||
sub is_ignored_title($self, $title) {
|
||||
return 1 if $title =~ m{reddit - dive into anything}i;
|
||||
return 1 if $title =~ m{dive into reddit}i;
|
||||
return 1 if $title =~ m{^Loading}i;
|
||||
return 1 if $title =~ m{streamable}i;
|
||||
@ -146,9 +140,7 @@ sub is_ignored_title {
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub get_title {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub get_title($self, $context) {
|
||||
my $url = $context->{arguments};
|
||||
|
||||
my $ua = LWP::UserAgent::Paranoid->new(request_timeout => TIMEOUT);
|
||||
@ -218,9 +210,7 @@ sub get_title {
|
||||
$context->{url} = $url;
|
||||
}
|
||||
|
||||
sub title_pipe_reader {
|
||||
my ($self, $pid, $buf) = @_;
|
||||
|
||||
sub title_pipe_reader($self, $pid, $buf) {
|
||||
# retrieve context object from child
|
||||
my $context = decode_json $buf or do {
|
||||
$self->{pbot}->{logger}->log("Failed to decode bad json: [$buf]\n");
|
||||
@ -260,9 +250,7 @@ sub title_pipe_reader {
|
||||
$self->{pbot}->{interpreter}->handle_result($context);
|
||||
}
|
||||
|
||||
sub show_url_titles {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
sub show_url_titles($self, $event_type, $event) {
|
||||
my ($nick, $user, $host) = (
|
||||
$event->nick,
|
||||
$event->user,
|
||||
|
||||
@ -13,9 +13,7 @@ use PBot::Imports;
|
||||
use PBot::Core::Utils::LWPUserAgentCached;
|
||||
use XML::LibXML;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'weather',
|
||||
help => 'Provides weather service via AccuWeather',
|
||||
@ -23,14 +21,11 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('weather');
|
||||
}
|
||||
|
||||
sub cmd_weather {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_weather($self, $context) {
|
||||
my $usage = "Usage: weather (<location> | -u <user account>)";
|
||||
|
||||
my $arguments = $context->{arguments};
|
||||
@ -67,9 +62,7 @@ sub cmd_weather {
|
||||
return $self->get_weather($arguments);
|
||||
}
|
||||
|
||||
sub get_weather {
|
||||
my ($self, $location) = @_;
|
||||
|
||||
sub get_weather($self, $location) {
|
||||
my %cache_opt = (
|
||||
'namespace' => 'accuweather',
|
||||
'default_expires_in' => 3600
|
||||
@ -119,8 +112,7 @@ sub get_weather {
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub fix_temps {
|
||||
my ($self, $text) = @_;
|
||||
sub fix_temps($self, $text) {
|
||||
$text =~ s|(-?\d+)\s*F|my $f = $1; my $c = ($f - 32 ) * 5 / 9; $c = sprintf("%.1d", $c); "${c}C/${f}F"|eg;
|
||||
return $text;
|
||||
}
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
#
|
||||
# Purpose: Query Wolfram|Alpha's Short Answers API.
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::Wolfram;
|
||||
@ -13,9 +13,7 @@ use PBot::Imports;
|
||||
use LWP::UserAgent::Paranoid;
|
||||
use URI::Escape qw/uri_escape_utf8/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
# add default registry entry for `wolfram.appid`
|
||||
$self->{pbot}->{registry}->add_default('text', 'wolfram', 'appid', '');
|
||||
|
||||
@ -30,14 +28,11 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('wolfram');
|
||||
}
|
||||
|
||||
sub cmd_wolfram {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_wolfram($self, $context) {
|
||||
return "Usage: wolfram <query>\n" if not length $context->{arguments};
|
||||
|
||||
my $appid = $self->{pbot}->{registry}->get_value('wolfram', 'appid');
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
# Purpose: Word morph game. Solve a path between two words by changing one
|
||||
# letter at a time. love > shot = love > lose > lost > loot > soot > shot.
|
||||
|
||||
# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-FileCopyrightText: 2022-2023 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package PBot::Plugin::WordMorph;
|
||||
@ -14,9 +14,7 @@ use PBot::Imports;
|
||||
use Storable;
|
||||
use Text::Levenshtein::XS 'distance';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'wordmorph',
|
||||
help => 'Word Morph game! Solve a path between two words by changing one letter at a time: love > shot = love > lose > lost > loot > soot > shot.',
|
||||
@ -29,8 +27,7 @@ sub initialize {
|
||||
or $self->{pbot}->{logger}->log($@);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my ($self) = @_;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('wordmorph');
|
||||
}
|
||||
|
||||
@ -47,9 +44,7 @@ use constant {
|
||||
MAX_WORD_LENGTH => 7,
|
||||
};
|
||||
|
||||
sub wordmorph {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub wordmorph($self, $context) {
|
||||
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments});
|
||||
|
||||
my $command = shift @args;
|
||||
@ -303,9 +298,7 @@ sub wordmorph {
|
||||
}
|
||||
}
|
||||
|
||||
sub load_db {
|
||||
my ($self) = @_;
|
||||
|
||||
sub load_db($self) {
|
||||
if (not -e $self->{db_path}) {
|
||||
die "Word morph database not available; run `/misc/wordmorph/wordmorph-mkdb` to create it.\n";
|
||||
}
|
||||
@ -313,9 +306,7 @@ sub load_db {
|
||||
return retrieve($self->{db_path});
|
||||
}
|
||||
|
||||
sub show_morph_with_blanks {
|
||||
my ($self, $channel) = @_;
|
||||
|
||||
sub show_morph_with_blanks($self, $channel) {
|
||||
my @middle;
|
||||
for (1 .. @{$self->{$channel}->{morph}} - 2) {
|
||||
push @middle, '_' x length $self->{$channel}->{word1};
|
||||
@ -324,8 +315,7 @@ sub show_morph_with_blanks {
|
||||
return "$self->{$channel}->{word1} > " . join(' > ', @middle) . " > $self->{$channel}->{word2}";
|
||||
}
|
||||
|
||||
sub set_up_new_morph {
|
||||
my ($self, $morph, $channel) = @_;
|
||||
sub set_up_new_morph($self, $morph, $channel) {
|
||||
$self->{$channel}->{morph} = $morph;
|
||||
$self->{$channel}->{word1} = $morph->[0];
|
||||
$self->{$channel}->{word2} = $morph->[$#$morph];
|
||||
@ -333,9 +323,7 @@ sub set_up_new_morph {
|
||||
$self->{$channel}->{hintR} = $#$morph - 1;
|
||||
}
|
||||
|
||||
sub form_hint {
|
||||
my ($word1, $word2) = @_;
|
||||
|
||||
sub form_hint($word1, $word2) {
|
||||
my $hint = '';
|
||||
|
||||
for (0 .. length $word1) {
|
||||
@ -349,9 +337,7 @@ sub form_hint {
|
||||
return $hint;
|
||||
}
|
||||
|
||||
sub validate_word {
|
||||
my ($self, $word, $min, $max) = @_;
|
||||
|
||||
sub validate_word($self, $word, $min, $max) {
|
||||
my $len = length $word;
|
||||
|
||||
if ($len < $min) {
|
||||
@ -367,9 +353,7 @@ sub validate_word {
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub compare_suffix {
|
||||
my ($word1, $word2) = @_;
|
||||
|
||||
sub compare_suffix($word1, $word2) {
|
||||
my $length = 0;
|
||||
|
||||
for (my $i = length($word1) - 1; $i >= 0; --$i) {
|
||||
@ -383,9 +367,7 @@ sub compare_suffix {
|
||||
return $length;
|
||||
}
|
||||
|
||||
sub make_morph_by_steps {
|
||||
my ($self, $db, $steps, $length) = @_;
|
||||
|
||||
sub make_morph_by_steps($self, $db, $steps, $length) {
|
||||
$length //= int(rand(3)) + 5;
|
||||
|
||||
my @words = keys %{$db->{$length}};
|
||||
@ -428,17 +410,14 @@ sub make_morph_by_steps {
|
||||
|
||||
# the following subs are based on https://www.perlmonks.org/?node_id=558123
|
||||
|
||||
sub makemorph {
|
||||
my ($db, $left, $right) = @_;
|
||||
sub makemorph($db, $left, $right) {
|
||||
die "The length of given words are not equal.\n" if length($left) != length($right);
|
||||
my $list = $db->{length $left};
|
||||
my $morph = eval { [transform(lc $left, lc $right, $list)] } or die $@;
|
||||
return $morph;
|
||||
}
|
||||
|
||||
sub transform {
|
||||
my ($left, $right, $list) = @_;
|
||||
|
||||
sub transform($left, $right, $list) {
|
||||
my (@left, %left, @right, %right); # @left and @right- arrays containing word relation trees: ([foo], [0, foe], [0, fou], [0, 1, fie] ...)
|
||||
# %left and %right - indices containing word offsets in arrays @left and @right
|
||||
|
||||
@ -502,9 +481,7 @@ sub transform {
|
||||
return @path;
|
||||
}
|
||||
|
||||
sub print_rel {
|
||||
my ($id, $ary) = @_;
|
||||
|
||||
sub print_rel($id, $ary) {
|
||||
my @rel = @{$ary->[$id]};
|
||||
my @line;
|
||||
|
||||
|
||||
@ -14,9 +14,7 @@ use PBot::Core::Utils::LWPUserAgentCached;
|
||||
use JSON;
|
||||
use URI::Escape qw/uri_escape_utf8/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
sub initialize($self, %conf) {
|
||||
$self->{pbot}->{commands}->add(
|
||||
name => 'wttr',
|
||||
help => 'Provides weather information via wttr.in',
|
||||
@ -24,14 +22,11 @@ sub initialize {
|
||||
);
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
sub unload($self) {
|
||||
$self->{pbot}->{commands}->remove('wttr');
|
||||
}
|
||||
|
||||
sub cmd_wttr {
|
||||
my ($self, $context) = @_;
|
||||
|
||||
sub cmd_wttr($self, $context) {
|
||||
my $arguments = $context->{arguments};
|
||||
|
||||
my @wttr_options = (
|
||||
@ -104,9 +99,7 @@ sub cmd_wttr {
|
||||
return $self->get_wttr($arguments, \@opts, \@wttr_options);
|
||||
}
|
||||
|
||||
sub get_wttr {
|
||||
my ($self, $location, $options, $order) = @_;
|
||||
|
||||
sub get_wttr($self, $location, $options, $order) {
|
||||
my %cache_opt = (
|
||||
'namespace' => 'wttr',
|
||||
'default_expires_in' => 900
|
||||
|
||||
@ -25,7 +25,7 @@ use PBot::Imports;
|
||||
# These are set by the /misc/update_version script
|
||||
use constant {
|
||||
BUILD_NAME => "PBot",
|
||||
BUILD_REVISION => 4645,
|
||||
BUILD_REVISION => 4646,
|
||||
BUILD_DATE => "2023-04-13",
|
||||
};
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user