From cd60ac9fc73b8f47336f113b22d8dd23c1ead9ba Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Thu, 13 Apr 2023 17:01:23 -0700 Subject: [PATCH] Update plugins to use subroutine signatures --- lib/PBot/Plugin/ActionTrigger.pm | 69 +-- lib/PBot/Plugin/AntiAway.pm | 15 +- lib/PBot/Plugin/AntiKickAutoRejoin.pm | 12 +- lib/PBot/Plugin/AntiNickSpam.pm | 22 +- lib/PBot/Plugin/AntiRepeat.pm | 10 +- lib/PBot/Plugin/AntiTwitter.pm | 9 +- lib/PBot/Plugin/AutoRejoin.pm | 20 +- lib/PBot/Plugin/Base.pm | 10 +- lib/PBot/Plugin/Battleship.pm | 124 ++--- lib/PBot/Plugin/Connect4.pm | 116 ++--- lib/PBot/Plugin/Counter.pm | 159 +++--- lib/PBot/Plugin/Date.pm | 11 +- lib/PBot/Plugin/Example.pm | 11 +- lib/PBot/Plugin/FuncBuiltins.pm | 46 +- lib/PBot/Plugin/FuncGrep.pm | 12 +- lib/PBot/Plugin/FuncSed.pm | 11 +- lib/PBot/Plugin/GetUrl.pm | 13 +- lib/PBot/Plugin/ParseDate.pm | 9 +- lib/PBot/Plugin/Plang.pm | 33 +- lib/PBot/Plugin/Quotegrabs.pm | 26 +- .../Plugin/Quotegrabs/Storage/Hashtable.pm | 46 +- lib/PBot/Plugin/RelayUnreg.pm | 12 +- lib/PBot/Plugin/RestrictedMod.pm | 39 +- lib/PBot/Plugin/RunCommand.pm | 17 +- lib/PBot/Plugin/Spinach.pm | 489 +++++++----------- lib/PBot/Plugin/Spinach/Rank.pm | 42 +- lib/PBot/Plugin/Spinach/Stats.pm | 36 +- lib/PBot/Plugin/TypoSub.pm | 10 +- lib/PBot/Plugin/UrlTitles.pm | 34 +- lib/PBot/Plugin/Weather.pm | 18 +- lib/PBot/Plugin/Wolfram.pm | 13 +- lib/PBot/Plugin/WordMorph.pm | 51 +- lib/PBot/Plugin/Wttr.pm | 15 +- lib/PBot/VERSION.pm | 2 +- 34 files changed, 557 insertions(+), 1005 deletions(-) diff --git a/lib/PBot/Plugin/ActionTrigger.pm b/lib/PBot/Plugin/ActionTrigger.pm index 38e98647..b0b321e9 100644 --- a/lib/PBot/Plugin/ActionTrigger.pm +++ b/lib/PBot/Plugin/ActionTrigger.pm @@ -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}; diff --git a/lib/PBot/Plugin/AntiAway.pm b/lib/PBot/Plugin/AntiAway.pm index 16710a59..8571ff54 100644 --- a/lib/PBot/Plugin/AntiAway.pm +++ b/lib/PBot/Plugin/AntiAway.pm @@ -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, diff --git a/lib/PBot/Plugin/AntiKickAutoRejoin.pm b/lib/PBot/Plugin/AntiKickAutoRejoin.pm index be3347b6..56931a14 100644 --- a/lib/PBot/Plugin/AntiKickAutoRejoin.pm +++ b/lib/PBot/Plugin/AntiKickAutoRejoin.pm @@ -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; diff --git a/lib/PBot/Plugin/AntiNickSpam.pm b/lib/PBot/Plugin/AntiNickSpam.pm index 5ad92663..6505f5ed 100644 --- a/lib/PBot/Plugin/AntiNickSpam.pm +++ b/lib/PBot/Plugin/AntiNickSpam.pm @@ -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; diff --git a/lib/PBot/Plugin/AntiRepeat.pm b/lib/PBot/Plugin/AntiRepeat.pm index 5ee8f310..807dfe1d 100644 --- a/lib/PBot/Plugin/AntiRepeat.pm +++ b/lib/PBot/Plugin/AntiRepeat.pm @@ -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, diff --git a/lib/PBot/Plugin/AntiTwitter.pm b/lib/PBot/Plugin/AntiTwitter.pm index 1bf865c2..27c2806a 100644 --- a/lib/PBot/Plugin/AntiTwitter.pm +++ b/lib/PBot/Plugin/AntiTwitter.pm @@ -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}; diff --git a/lib/PBot/Plugin/AutoRejoin.pm b/lib/PBot/Plugin/AutoRejoin.pm index 4faf4438..f106eb6f 100644 --- a/lib/PBot/Plugin/AutoRejoin.pm +++ b/lib/PBot/Plugin/AutoRejoin.pm @@ -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, diff --git a/lib/PBot/Plugin/Base.pm b/lib/PBot/Plugin/Base.pm index 65f36387..67c48967 100644 --- a/lib/PBot/Plugin/Base.pm +++ b/lib/PBot/Plugin/Base.pm @@ -2,23 +2,21 @@ # # Purpose: Base class for PBot plugins. -# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software # 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; diff --git a/lib/PBot/Plugin/Battleship.pm b/lib/PBot/Plugin/Battleship.pm index 70f5cecd..e42f8eb0 100644 --- a/lib/PBot/Plugin/Battleship.pm +++ b/lib/PBot/Plugin/Battleship.pm @@ -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 "; # 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; diff --git a/lib/PBot/Plugin/Connect4.pm b/lib/PBot/Plugin/Connect4.pm index 9cd4623e..b9d1baa6 100644 --- a/lib/PBot/Plugin/Connect4.pm +++ b/lib/PBot/Plugin/Connect4.pm @@ -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 "; 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; diff --git a/lib/PBot/Plugin/Counter.pm b/lib/PBot/Plugin/Counter.pm index c4f342af..a4ea724c 100644 --- a/lib/PBot/Plugin/Counter.pm +++ b/lib/PBot/Plugin/Counter.pm @@ -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 "; } + if (not defined $name or not defined $description) { + return "Usage: counteradd "; + } } 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 "; } + if (not defined $channel or not defined $name or $channel !~ m/^#/) { + return "Usage from private message: counterdel "; + } } 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 "; } + if (not defined $channel or not defined $name or $channel !~ m/^#/) { + return "Usage from private message: counterreset "; + } } 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 "; } + if (not defined $channel or not defined $name or $channel !~ m/^#/) { + return "Usage from private message: countershow "; + } } 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 "; } + if (not length $context->{arguments} or $context->{arguments} !~ m/^#/) { + return "Usage from private message: counterlist "; + } + $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 "; @@ -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 "; } - else { $result = "Usage: countertrigger add "; } + if ($context->{from} !~ m/^#/) { + $result = "Usage from private message: countertrigger add "; + } else { + $result = "Usage: countertrigger add "; + } + $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; } diff --git a/lib/PBot/Plugin/Date.pm b/lib/PBot/Plugin/Date.pm index b3625711..d10d0aa0 100644 --- a/lib/PBot/Plugin/Date.pm +++ b/lib/PBot/Plugin/Date.pm @@ -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 ] [timezone]"; my %opts; diff --git a/lib/PBot/Plugin/Example.pm b/lib/PBot/Plugin/Example.pm index b71df833..ba499d9f 100644 --- a/lib/PBot/Plugin/Example.pm +++ b/lib/PBot/Plugin/Example.pm @@ -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, diff --git a/lib/PBot/Plugin/FuncBuiltins.pm b/lib/PBot/Plugin/FuncBuiltins.pm index c584b0b5..5b69a0fc 100644 --- a/lib/PBot/Plugin/FuncBuiltins.pm +++ b/lib/PBot/Plugin/FuncBuiltins.pm @@ -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/^"(.*?)(?{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 = ''; diff --git a/lib/PBot/Plugin/FuncSed.pm b/lib/PBot/Plugin/FuncSed.pm index 490522c0..f03dd3b4 100644 --- a/lib/PBot/Plugin/FuncSed.pm +++ b/lib/PBot/Plugin/FuncSed.pm @@ -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(.)(.*?)(? +# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software # 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 \n" if not length $context->{arguments}; my $enabled = $self->{pbot}->{registry}->get_value('geturl', 'enabled'); diff --git a/lib/PBot/Plugin/ParseDate.pm b/lib/PBot/Plugin/ParseDate.pm index 35412a4c..0665dad7 100644 --- a/lib/PBot/Plugin/ParseDate.pm +++ b/lib/PBot/Plugin/ParseDate.pm @@ -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; diff --git a/lib/PBot/Plugin/Plang.pm b/lib/PBot/Plugin/Plang.pm index 939984ac..ee296595 100644 --- a/lib/PBot/Plugin/Plang.pm +++ b/lib/PBot/Plugin/Plang.pm @@ -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 ; 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 ; 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]); diff --git a/lib/PBot/Plugin/Quotegrabs.pm b/lib/PBot/Plugin/Quotegrabs.pm index 8bc8e79e..2a369204 100644 --- a/lib/PBot/Plugin/Quotegrabs.pm +++ b/lib/PBot/Plugin/Quotegrabs.pm @@ -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 [history [channel]] [+ [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 ] [-t ]'; my ($nick_search, $channel_search, $text_search); diff --git a/lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm b/lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm index fb8682b7..1058982e 100644 --- a/lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm +++ b/lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm @@ -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 +# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software # 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}; } diff --git a/lib/PBot/Plugin/RelayUnreg.pm b/lib/PBot/Plugin/RelayUnreg.pm index db112b8b..8db1433a 100644 --- a/lib/PBot/Plugin/RelayUnreg.pm +++ b/lib/PBot/Plugin/RelayUnreg.pm @@ -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}}) { diff --git a/lib/PBot/Plugin/RestrictedMod.pm b/lib/PBot/Plugin/RestrictedMod.pm index 78357ac8..f02fc139 100644 --- a/lib/PBot/Plugin/RestrictedMod.pm +++ b/lib/PBot/Plugin/RestrictedMod.pm @@ -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; diff --git a/lib/PBot/Plugin/RunCommand.pm b/lib/PBot/Plugin/RunCommand.pm index 96cae45e..3741d356 100644 --- a/lib/PBot/Plugin/RunCommand.pm +++ b/lib/PBot/Plugin/RunCommand.pm @@ -17,7 +17,7 @@ # # This plugin is not in data/plugin_autoload. Load at your own risk. -# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software # 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; diff --git a/lib/PBot/Plugin/Spinach.pm b/lib/PBot/Plugin/Spinach.pm index b26949cc..e363bbad 100644 --- a/lib/PBot/Plugin/Spinach.pm +++ b/lib/PBot/Plugin/Spinach.pm @@ -6,7 +6,7 @@ # bot. Then all "lies" are revealed along with the true answer. Players # gain points every time another player picks their lie. Very fun! -# SPDX-FileCopyrightText: 2018-2021 Pragmatic Software +# SPDX-FileCopyrightText: 2018-2023 Pragmatic Software # SPDX-License-Identifier: MIT package PBot::Plugin::Spinach; @@ -39,9 +39,7 @@ $Data::Dumper::Sortkeys = sub { $Data::Dumper::Useqq = 1; -sub initialize { - my ($self, %conf) = @_; - +sub initialize($self, %conf) { $self->{pbot}->{commands}->register(sub { $self->cmd_spinach(@_) }, 'spinach'); $self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_departure(@_) }); @@ -72,8 +70,7 @@ sub initialize { $self->{tock_duration} = 30; } -sub unload { - my $self = shift; +sub unload($self) { $self->{pbot}->{commands}->unregister('spinach'); $self->{pbot}->{event_queue}->dequeue_event('spinach loop'); $self->{stats}->end if $self->{stats_running}; @@ -82,8 +79,7 @@ sub unload { $self->{pbot}->{event_dispatcher}->remove_handler('irc.kick'); } -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]; @@ -92,8 +88,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}; @@ -101,11 +96,12 @@ sub on_departure { return 0; } -sub load_questions { - my ($self, $filename) = @_; - - if (not defined $filename) { $filename = exists $self->{loaded_filename} ? $self->{loaded_filename} : $self->{questions_filename}; } - else { $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . "/spinach/$filename"; } +sub load_questions($self, $filename) { + if (not defined $filename) { + $filename = exists $self->{loaded_filename} ? $self->{loaded_filename} : $self->{questions_filename}; + } else { + $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . "/spinach/$filename"; + } $self->{pbot}->{logger}->log("Spinach: Loading questions from $filename...\n"); @@ -151,8 +147,7 @@ sub load_questions { return "Loaded $questions questions in $categories categories."; } -sub save_questions { - my $self = shift; +sub save_questions($self) { my $json = JSON->new; my $json_text = $json->pretty->canonical->utf8->encode($self->{questions}); my $filename = exists $self->{loaded_filename} ? $self->{loaded_filename} : $self->{questions_filename}; @@ -164,9 +159,7 @@ sub save_questions { close $fh; } -sub load_stopwords { - my $self = shift; - +sub load_stopwords($self) { open my $fh, '<', $self->{stopwords_filename} or do { $self->{pbot}->{logger}->log("Spinach: Failed to open $self->{stopwords_filename}: $!\n"); return; @@ -179,8 +172,7 @@ sub load_stopwords { close $fh; } -sub set_metadata_defaults { - my ($self) = @_; +sub set_metadata_defaults($self) { my $defaults = { category_choices => 7, category_autopick => 0, @@ -193,10 +185,13 @@ sub set_metadata_defaults { debug_state => 0, }; - if ($self->{metadata}->exists('settings')) { $self->{metadata}->add('settings', $defaults, 1); } - else { + if ($self->{metadata}->exists('settings')) { + $self->{metadata}->add('settings', $defaults, 1); + } else { foreach my $key (keys %$defaults) { - if (not $self->{metadata}->exists('settings', $key)) { $self->{metadata}->set('settings', $key, $defaults->{$key}, 1); } + if (not $self->{metadata}->exists('settings', $key)) { + $self->{metadata}->set('settings', $key, $defaults->{$key}, 1); + } } } } @@ -227,8 +222,7 @@ my %color = ( reset => "\x0F", ); -sub cmd_spinach { - my ($self, $context) = @_; +sub cmd_spinach($self, $context) { my $arguments = $context->{arguments}; $arguments =~ s/^\s+|\s+$//g; @@ -285,8 +279,11 @@ sub cmd_spinach { when ('rank') { return "Help is coming soon."; } default { - if (length $arguments) { return "Spinach has no such command '$arguments'. I can't help you with that."; } - else { return "Usage: spinach help "; } + if (length $arguments) { + return "Spinach has no such command '$arguments'. I can't help you with that."; + } else { + return "Usage: spinach help "; + } } } } @@ -333,7 +330,10 @@ sub cmd_spinach { when ('load') { my $u = $self->{pbot}->{users}->loggedin($self->{channel}, $context->{hostmask}); - if (not $u or not $self->{pbot}->{capabilities}->userhas($u, 'botowner')) { return "$context->{nick}: Sorry, only botowners may reload the questions."; } + + if (not $u or not $self->{pbot}->{capabilities}->userhas($u, 'botowner')) { + return "$context->{nick}: Sorry, only botowners may reload the questions."; + } $arguments = undef if not length $arguments; return $self->load_questions($arguments); @@ -413,7 +413,9 @@ sub cmd_spinach { } if ($removed) { - if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 } + if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { + $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1; + } if (not @{$self->{state_data}->{players}}) { $self->{current_state} = 'nogame'; @@ -428,7 +430,9 @@ sub cmd_spinach { } when ('abort') { - if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, $context->{hostmask})) { return "$context->{nick}: Sorry, only admins may abort the game."; } + if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, $context->{hostmask})) { + return "$context->{nick}: Sorry, only admins may abort the game."; + } $self->{current_state} = 'gameover'; return "/msg $self->{channel} $context->{nick}: The game has been aborted."; @@ -438,8 +442,11 @@ sub cmd_spinach { if ($self->{current_state} eq 'getplayers') { my @names; foreach my $player (@{$self->{state_data}->{players}}) { - if (not $player->{ready}) { push @names, "$player->{name} $color{red}(not ready)$color{reset}"; } - else { push @names, $player->{name}; } + if (not $player->{ready}) { + push @names, "$player->{name} $color{red}(not ready)$color{reset}"; + } else { + push @names, $player->{name}; + } } my $players = join ', ', @names; @@ -460,7 +467,9 @@ sub cmd_spinach { } when ('kick') { - if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, $context->{hostmask})) { return "$context->{nick}: Sorry, only admins may kick people from the game."; } + if (not $self->{pbot}->{users}->loggedin_admin($self->{channel}, $context->{hostmask})) { + return "$context->{nick}: Sorry, only admins may kick people from the game."; + } if (not length $arguments) { return "Usage: spinach kick "; } @@ -474,7 +483,9 @@ sub cmd_spinach { } if ($removed) { - if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 } + if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { + $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1; + } return "/msg $self->{channel} $context->{nick}: $arguments has been kicked from the game."; } else { return "$context->{nick}: $arguments isn't even in the game."; @@ -596,7 +607,9 @@ sub cmd_spinach { return "$context->{nick}: It is not your turn to choose a category."; } - if ($arguments !~ /^[0-9]+$/) { return "$context->{nick}: Please choose a category number. $self->{state_data}->{categories_text}"; } + if ($arguments !~ /^[0-9]+$/) { + return "$context->{nick}: Please choose a category number. $self->{state_data}->{categories_text}"; + } $arguments--; @@ -636,16 +649,11 @@ sub cmd_spinach { my @truth_count = split /\s/, $self->{state_data}->{current_question}->{answer}; my @lie_count = split /\s/, $arguments; - -=cut - if (@truth_count > 1 and @lie_count == 1) { - return "/msg $context->{nick} Your lie cannot be one word for this question. Please try again."; - } -=cut - my $found_truth = 0; - if (not $self->validate_lie($self->{state_data}->{current_question}->{answer}, $arguments)) { $found_truth = 1; } + if (not $self->validate_lie($self->{state_data}->{current_question}->{answer}, $arguments)) { + $found_truth = 1; + } foreach my $alt (@{$self->{state_data}->{current_question}->{alternativeSpellings}}) { if (not $self->validate_lie($alt, $arguments)) { @@ -654,7 +662,9 @@ sub cmd_spinach { } } - if (not $found_truth and ++$player->{lie_count} > 2) { return "/msg $context->{nick} You cannot change your lie again this round."; } + if (not $found_truth and ++$player->{lie_count} > 2) { + return "/msg $context->{nick} You cannot change your lie again this round."; + } if ($found_truth) { $self->send_message($self->{channel}, "$color{yellow}$context->{nick} has found the truth!$color{reset}"); @@ -681,9 +691,13 @@ sub cmd_spinach { } } - if (not $player) { return "$context->{nick}: You are not playing in this game. Use `j` to start playing now!"; } + if (not $player) { + return "$context->{nick}: You are not playing in this game. Use `j` to start playing now!"; + } - if ($arguments !~ /^[0-9]+$/) { return "$context->{nick}: Please select a truth number. $self->{state_data}->{current_choices_text}"; } + if ($arguments !~ /^[0-9]+$/) { + return "$context->{nick}: Please select a truth number. $self->{state_data}->{current_choices_text}"; + } $arguments--; @@ -855,9 +869,7 @@ sub cmd_spinach { return $result; } -sub player_left { - my ($self, $nick, $user, $host) = @_; - +sub player_left($self, $nick, $user, $host) { my $id = $self->{pbot}->{messagehistory}->{database}->get_message_account_ancestor($nick, $user, $host); my $removed = 0; @@ -869,14 +881,14 @@ sub player_left { } if ($removed) { - if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1 } + if ($self->{state_data}->{current_player} >= @{$self->{state_data}->{players}}) { + $self->{state_data}->{current_player} = @{$self->{state_data}->{players}} - 1; + } $self->send_message($self->{channel}, "$nick has left the game!"); } } -sub send_message { - my ($self, $to, $text, $delay) = @_; - $delay = 0 if not defined $delay; +sub send_message($self, $to, $text, $delay = 0) { my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); my $message = { nick => $botnick, @@ -890,9 +902,7 @@ sub send_message { $self->{pbot}->{interpreter}->add_message_to_output_queue($to, $message, $delay); } -sub add_new_suggestions { - my ($self, $state) = @_; - +sub add_new_suggestions($self, $state) { my $question = undef; my $modified = 0; @@ -919,9 +929,7 @@ sub add_new_suggestions { if ($modified) { $self->save_questions; } } -sub run_one_state { - my $self = shift; - +sub run_one_state($self) { # check for naughty or missing players if ($self->{current_state} =~ /r\dq\d/) { my $removed = 0; @@ -992,7 +1000,6 @@ sub run_one_state { if (not exists $self->{states}{$self->{current_state}}{trans}{$state_data->{result}}) { $self->{pbot}->{logger}->log("Spinach: State broke: no such transistion to $state_data->{result} for state $self->{current_state}\n"); - # XXX: do something here } @@ -1003,9 +1010,7 @@ sub run_one_state { $self->{state_data}->{ticks}++; } -sub create_states { - my $self = shift; - +sub create_states($self) { $self->{pbot}->{logger}->log("Spinach: Creating game state machine\n"); $self->{previous_state} = ''; @@ -1339,30 +1344,28 @@ sub create_states { $self->{states}{'gameover'}{trans}{next} = 'getplayers'; } -sub commify { - my $self = shift; +sub commify($self) { my $text = reverse $_[0]; $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; return scalar reverse $text; } -sub normalize_question { - my ($self, $text) = @_; - +sub normalize_question($self, $text) { my @words = split / /, $text; my $uc = 0; + foreach my $word (@words) { if ($word =~ m/^[A-Z]/) { $uc++; } } - if ($uc >= @words * .8) { $text = ucfirst lc $text; } + if ($uc >= @words * .8) { + $text = ucfirst lc $text; + } return $text; } -sub normalize_text { - my ($self, $text) = @_; - +sub normalize_text($self, $text) { $text = unidecode $text; $text =~ s/^\s+|\s+$//g; @@ -1432,9 +1435,7 @@ sub normalize_text { return substr $text, 0, 80; } -sub validate_lie { - my ($self, $truth, $lie) = @_; - +sub validate_lie($self, $truth, $lie) { my %truth_words = @{stem map { $_ => 1 } grep { /^\w+$/ and not exists $self->{stopwords}{lc $_} } split /\b/, $truth}; my $truth_word_count = keys %truth_words; @@ -1461,9 +1462,7 @@ sub validate_lie { # generic state subroutines -sub choosecategory { - my ($self, $state) = @_; - +sub choosecategory($self, $state) { if ($state->{init} or $state->{reroll_category}) { delete $state->{current_category}; $state->{current_player}++ unless $state->{reroll_category}; @@ -1521,7 +1520,6 @@ sub choosecategory { if (not @choices) { $self->{pbot}->{logger}->log("Out of questions with current settings!\n"); - # XXX: do something useful here } @@ -1593,9 +1591,7 @@ sub choosecategory { else { return 'wait'; } } -sub getnewquestion { - my ($self, $state) = @_; - +sub getnewquestion($self, $state) { if ($state->{ticks} % 3 == 0) { my @questions = keys %{$self->{categories}{$state->{current_category}}}; @@ -1665,9 +1661,7 @@ sub getnewquestion { } } -sub showquestion { - my ($self, $state, $show_category) = @_; - +sub showquestion($self, $state, $show_category) { return if $state->{reroll_category}; if (exists $state->{current_question}) { @@ -1687,9 +1681,7 @@ sub showquestion { } } -sub getlies { - my ($self, $state) = @_; - +sub getlies($self, $state) { return 'skip' if $state->{reroll_category}; my $tock; @@ -1780,9 +1772,7 @@ sub getlies { return 'wait'; } -sub findtruth { - my ($self, $state) = @_; - +sub findtruth($self, $state) { my $tock; if ($state->{first_tock}) { $tock = 3; } else { $tock = $self->{tock_duration}; } @@ -1884,9 +1874,7 @@ sub findtruth { return 'wait'; } -sub showlies { - my ($self, $state) = @_; - +sub showlies($self, $state) { my @liars; my $player; @@ -1972,9 +1960,7 @@ sub showlies { return 'wait'; } -sub showtruth { - my ($self, $state) = @_; - +sub showtruth($self, $state) { if ($state->{ticks} % 3 == 0) { my $player_id; my $player_data; @@ -2019,9 +2005,7 @@ sub showtruth { } } -sub reveallies { - my ($self, $state) = @_; - +sub reveallies($self, $state) { if ($state->{ticks} % 3 == 0) { my $text = 'Revealing lies! '; my $comma = ''; @@ -2048,9 +2032,7 @@ sub reveallies { } } -sub showscore { - my ($self, $state) = @_; - +sub showscore($self, $state) { if ($state->{ticks} % 3 == 0) { my $text = ''; my $comma = ''; @@ -2068,9 +2050,7 @@ sub showscore { } } -sub showfinalscore { - my ($self, $state) = @_; - +sub showfinalscore($self, $state) { if ($state->{newstate}) { my $player_id; @@ -2153,8 +2133,7 @@ sub showfinalscore { # state subroutines -sub nogame { - my ($self, $state) = @_; +sub nogame($self, $state) { if ($self->{stats_running}) { $self->{stats}->end; delete $self->{stats_running}; @@ -2164,9 +2143,7 @@ sub nogame { return $state; } -sub getplayers { - my ($self, $state) = @_; - +sub getplayers($self, $state) { my $players = $state->{players}; my @names; @@ -2226,8 +2203,7 @@ sub getplayers { return $state; } -sub round1 { - my ($self, $state) = @_; +sub round1($self, $state) { if ($self->{metadata}->get_data('settings', 'stats')) { $self->{stats}->begin; $self->{stats_running} = 1; @@ -2239,8 +2215,7 @@ sub round1 { return $state; } -sub round1q1 { - my ($self, $state) = @_; +sub round1q1($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{counter} = 0; @@ -2254,14 +2229,12 @@ sub round1q1 { return $state; } -sub r1q1choosecategory { - my ($self, $state) = @_; +sub r1q1choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r1q1showquestion { - my ($self, $state) = @_; +sub r1q1showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2277,8 +2250,7 @@ sub r1q1showquestion { return $state; } -sub r1q1getlies { - my ($self, $state) = @_; +sub r1q1getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2289,38 +2261,32 @@ sub r1q1getlies { return $state; } -sub r1q1findtruth { - my ($self, $state) = @_; +sub r1q1findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r1q1showlies { - my ($self, $state) = @_; +sub r1q1showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r1q1showtruth { - my ($self, $state) = @_; +sub r1q1showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r1q1reveallies { - my ($self, $state) = @_; +sub r1q1reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r1q1showscore { - my ($self, $state) = @_; +sub r1q1showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round1q2 { - my ($self, $state) = @_; +sub round1q2($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{counter} = 0; @@ -2334,14 +2300,12 @@ sub round1q2 { return $state; } -sub r1q2choosecategory { - my ($self, $state) = @_; +sub r1q2choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r1q2showquestion { - my ($self, $state) = @_; +sub r1q2showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2357,8 +2321,7 @@ sub r1q2showquestion { return $state; } -sub r1q2getlies { - my ($self, $state) = @_; +sub r1q2getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2369,38 +2332,32 @@ sub r1q2getlies { return $state; } -sub r1q2findtruth { - my ($self, $state) = @_; +sub r1q2findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r1q2showlies { - my ($self, $state) = @_; +sub r1q2showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r1q2showtruth { - my ($self, $state) = @_; +sub r1q2showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r1q2reveallies { - my ($self, $state) = @_; +sub r1q2reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r1q2showscore { - my ($self, $state) = @_; +sub r1q2showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round1q3 { - my ($self, $state) = @_; +sub round1q3($self, $state) { if ($state->{ticks} % 2 || $state->{reroll_category}) { $state->{init} = 1; $state->{max_count} = $self->{choosecategory_max_count}; @@ -2414,14 +2371,12 @@ sub round1q3 { return $state; } -sub r1q3choosecategory { - my ($self, $state) = @_; +sub r1q3choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r1q3showquestion { - my ($self, $state) = @_; +sub r1q3showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2437,8 +2392,7 @@ sub r1q3showquestion { return $state; } -sub r1q3getlies { - my ($self, $state) = @_; +sub r1q3getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2449,38 +2403,32 @@ sub r1q3getlies { return $state; } -sub r1q3findtruth { - my ($self, $state) = @_; +sub r1q3findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r1q3showlies { - my ($self, $state) = @_; +sub r1q3showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r1q3showtruth { - my ($self, $state) = @_; +sub r1q3showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r1q3reveallies { - my ($self, $state) = @_; +sub r1q3reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r1q3showscore { - my ($self, $state) = @_; +sub r1q3showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round2 { - my ($self, $state) = @_; +sub round2($self, $state) { $state->{truth_points} = 750; $state->{lie_points} = 1500; $state->{my_lie_points} = $state->{lie_points} * 0.25; @@ -2488,8 +2436,7 @@ sub round2 { return $state; } -sub round2q1 { - my ($self, $state) = @_; +sub round2q1($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{max_count} = $self->{choosecategory_max_count}; @@ -2503,14 +2450,12 @@ sub round2q1 { return $state; } -sub r2q1choosecategory { - my ($self, $state) = @_; +sub r2q1choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r2q1showquestion { - my ($self, $state) = @_; +sub r2q1showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2526,8 +2471,7 @@ sub r2q1showquestion { return $state; } -sub r2q1getlies { - my ($self, $state) = @_; +sub r2q1getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2538,38 +2482,32 @@ sub r2q1getlies { return $state; } -sub r2q1findtruth { - my ($self, $state) = @_; +sub r2q1findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r2q1showlies { - my ($self, $state) = @_; +sub r2q1showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r2q1showtruth { - my ($self, $state) = @_; +sub r2q1showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r2q1reveallies { - my ($self, $state) = @_; +sub r2q1reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r2q1showscore { - my ($self, $state) = @_; +sub r2q1showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round2q2 { - my ($self, $state) = @_; +sub round2q2($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{max_count} = $self->{choosecategory_max_count}; @@ -2583,14 +2521,12 @@ sub round2q2 { return $state; } -sub r2q2choosecategory { - my ($self, $state) = @_; +sub r2q2choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r2q2showquestion { - my ($self, $state) = @_; +sub r2q2showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2606,8 +2542,7 @@ sub r2q2showquestion { return $state; } -sub r2q2getlies { - my ($self, $state) = @_; +sub r2q2getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2618,38 +2553,32 @@ sub r2q2getlies { return $state; } -sub r2q2findtruth { - my ($self, $state) = @_; +sub r2q2findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r2q2showlies { - my ($self, $state) = @_; +sub r2q2showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r2q2showtruth { - my ($self, $state) = @_; +sub r2q2showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r2q2reveallies { - my ($self, $state) = @_; +sub r2q2reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r2q2showscore { - my ($self, $state) = @_; +sub r2q2showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round2q3 { - my ($self, $state) = @_; +sub round2q3($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{max_count} = $self->{choosecategory_max_count}; @@ -2663,14 +2592,12 @@ sub round2q3 { return $state; } -sub r2q3choosecategory { - my ($self, $state) = @_; +sub r2q3choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r2q3showquestion { - my ($self, $state) = @_; +sub r2q3showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2686,8 +2613,7 @@ sub r2q3showquestion { return $state; } -sub r2q3getlies { - my ($self, $state) = @_; +sub r2q3getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2698,38 +2624,32 @@ sub r2q3getlies { return $state; } -sub r2q3findtruth { - my ($self, $state) = @_; +sub r2q3findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r2q3showlies { - my ($self, $state) = @_; +sub r2q3showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r2q3showtruth { - my ($self, $state) = @_; +sub r2q3showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r2q3reveallies { - my ($self, $state) = @_; +sub r2q3reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r2q3showscore { - my ($self, $state) = @_; +sub r2q3showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round3 { - my ($self, $state) = @_; +sub round3($self, $state) { $state->{truth_points} = 1000; $state->{lie_points} = 2000; $state->{my_lie_points} = $state->{lie_points} * 0.25; @@ -2737,8 +2657,7 @@ sub round3 { return $state; } -sub round3q1 { - my ($self, $state) = @_; +sub round3q1($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{max_count} = $self->{choosecategory_max_count}; @@ -2752,14 +2671,12 @@ sub round3q1 { return $state; } -sub r3q1choosecategory { - my ($self, $state) = @_; +sub r3q1choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r3q1showquestion { - my ($self, $state) = @_; +sub r3q1showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2775,8 +2692,7 @@ sub r3q1showquestion { return $state; } -sub r3q1getlies { - my ($self, $state) = @_; +sub r3q1getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2787,38 +2703,32 @@ sub r3q1getlies { return $state; } -sub r3q1findtruth { - my ($self, $state) = @_; +sub r3q1findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r3q1showlies { - my ($self, $state) = @_; +sub r3q1showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r3q1showtruth { - my ($self, $state) = @_; +sub r3q1showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r3q1reveallies { - my ($self, $state) = @_; +sub r3q1reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r3q1showscore { - my ($self, $state) = @_; +sub r3q1showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round3q2 { - my ($self, $state) = @_; +sub round3q2($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{max_count} = $self->{choosecategory_max_count}; @@ -2832,14 +2742,12 @@ sub round3q2 { return $state; } -sub r3q2choosecategory { - my ($self, $state) = @_; +sub r3q2choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r3q2showquestion { - my ($self, $state) = @_; +sub r3q2showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2855,8 +2763,7 @@ sub r3q2showquestion { return $state; } -sub r3q2getlies { - my ($self, $state) = @_; +sub r3q2getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2867,38 +2774,32 @@ sub r3q2getlies { return $state; } -sub r3q2findtruth { - my ($self, $state) = @_; +sub r3q2findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r3q2showlies { - my ($self, $state) = @_; +sub r3q2showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r3q2showtruth { - my ($self, $state) = @_; +sub r3q2showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r3q2reveallies { - my ($self, $state) = @_; +sub r3q2reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r3q2showscore { - my ($self, $state) = @_; +sub r3q2showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round3q3 { - my ($self, $state) = @_; +sub round3q3($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{max_count} = $self->{choosecategory_max_count}; @@ -2912,14 +2813,12 @@ sub round3q3 { return $state; } -sub r3q3choosecategory { - my ($self, $state) = @_; +sub r3q3choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r3q3showquestion { - my ($self, $state) = @_; +sub r3q3showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -2935,8 +2834,7 @@ sub r3q3showquestion { return $state; } -sub r3q3getlies { - my ($self, $state) = @_; +sub r3q3getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -2947,38 +2845,32 @@ sub r3q3getlies { return $state; } -sub r3q3findtruth { - my ($self, $state) = @_; +sub r3q3findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r3q3showlies { - my ($self, $state) = @_; +sub r3q3showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r3q3showtruth { - my ($self, $state) = @_; +sub r3q3showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r3q3reveallies { - my ($self, $state) = @_; +sub r3q3reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r3q3showscore { - my ($self, $state) = @_; +sub r3q3showscore($self, $state) { $state->{result} = $self->showscore($state); return $state; } -sub round4 { - my ($self, $state) = @_; +sub round4($self, $state) { $state->{truth_points} = 2000; $state->{lie_points} = 3000; $state->{my_lie_points} = $state->{lie_points} * 0.25; @@ -2986,8 +2878,7 @@ sub round4 { return $state; } -sub round4q1 { - my ($self, $state) = @_; +sub round4q1($self, $state) { if ($state->{ticks} % 2 == 0 || $state->{reroll_category}) { $state->{init} = 1; $state->{random_category} = 1; @@ -3002,14 +2893,12 @@ sub round4q1 { return $state; } -sub r4q1choosecategory { - my ($self, $state) = @_; +sub r4q1choosecategory($self, $state) { $state->{result} = $self->choosecategory($state); return $state; } -sub r4q1showquestion { - my ($self, $state) = @_; +sub r4q1showquestion($self, $state) { my $result = $self->getnewquestion($state); if ($result eq 'next') { @@ -3025,8 +2914,7 @@ sub r4q1showquestion { return $state; } -sub r4q1getlies { - my ($self, $state) = @_; +sub r4q1getlies($self, $state) { $state->{result} = $self->getlies($state); if ($state->{result} eq 'next') { @@ -3037,39 +2925,32 @@ sub r4q1getlies { return $state; } -sub r4q1findtruth { - my ($self, $state) = @_; +sub r4q1findtruth($self, $state) { $state->{result} = $self->findtruth($state); return $state; } -sub r4q1showlies { - my ($self, $state) = @_; +sub r4q1showlies($self, $state) { $state->{result} = $self->showlies($state); return $state; } -sub r4q1showtruth { - my ($self, $state) = @_; +sub r4q1showtruth($self, $state) { $state->{result} = $self->showtruth($state); return $state; } -sub r4q1reveallies { - my ($self, $state) = @_; +sub r4q1reveallies($self, $state) { $state->{result} = $self->reveallies($state); return $state; } -sub r4q1showscore { - my ($self, $state) = @_; +sub r4q1showscore($self, $state) { $state->{result} = $self->showfinalscore($state); return $state; } -sub gameover { - my ($self, $state) = @_; - +sub gameover($self, $state) { if ($state->{ticks} % 3 == 0) { $self->send_message($self->{channel}, "Game over!"); diff --git a/lib/PBot/Plugin/Spinach/Rank.pm b/lib/PBot/Plugin/Spinach/Rank.pm index d44dbcbd..926b7491 100644 --- a/lib/PBot/Plugin/Spinach/Rank.pm +++ b/lib/PBot/Plugin/Spinach/Rank.pm @@ -2,7 +2,7 @@ # # Purpose: Ranks players by various keywords. -# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software # 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', @_) }, diff --git a/lib/PBot/Plugin/Spinach/Stats.pm b/lib/PBot/Plugin/Spinach/Stats.pm index 6548bf8c..ede67db1 100644 --- a/lib/PBot/Plugin/Spinach/Stats.pm +++ b/lib/PBot/Plugin/Spinach/Stats.pm @@ -2,7 +2,7 @@ # # Purpose: Records player stats. -# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software # 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); diff --git a/lib/PBot/Plugin/TypoSub.pm b/lib/PBot/Plugin/TypoSub.pm index 7070077f..78a3c5dd 100644 --- a/lib/PBot/Plugin/TypoSub.pm +++ b/lib/PBot/Plugin/TypoSub.pm @@ -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]; diff --git a/lib/PBot/Plugin/UrlTitles.pm b/lib/PBot/Plugin/UrlTitles.pm index 8456e99f..4ab76aad 100644 --- a/lib/PBot/Plugin/UrlTitles.pm +++ b/lib/PBot/Plugin/UrlTitles.pm @@ -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, diff --git a/lib/PBot/Plugin/Weather.pm b/lib/PBot/Plugin/Weather.pm index b4db0ff9..743b83d1 100644 --- a/lib/PBot/Plugin/Weather.pm +++ b/lib/PBot/Plugin/Weather.pm @@ -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 ( | -u )"; 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; } diff --git a/lib/PBot/Plugin/Wolfram.pm b/lib/PBot/Plugin/Wolfram.pm index f452cb07..faea4521 100644 --- a/lib/PBot/Plugin/Wolfram.pm +++ b/lib/PBot/Plugin/Wolfram.pm @@ -2,7 +2,7 @@ # # Purpose: Query Wolfram|Alpha's Short Answers API. -# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-FileCopyrightText: 2021-2023 Pragmatic Software # 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 \n" if not length $context->{arguments}; my $appid = $self->{pbot}->{registry}->get_value('wolfram', 'appid'); diff --git a/lib/PBot/Plugin/WordMorph.pm b/lib/PBot/Plugin/WordMorph.pm index 00ad7e18..32bb7b35 100644 --- a/lib/PBot/Plugin/WordMorph.pm +++ b/lib/PBot/Plugin/WordMorph.pm @@ -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 +# SPDX-FileCopyrightText: 2022-2023 Pragmatic Software # 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; diff --git a/lib/PBot/Plugin/Wttr.pm b/lib/PBot/Plugin/Wttr.pm index 8d608e06..5bec023a 100644 --- a/lib/PBot/Plugin/Wttr.pm +++ b/lib/PBot/Plugin/Wttr.pm @@ -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 diff --git a/lib/PBot/VERSION.pm b/lib/PBot/VERSION.pm index dc64f73a..280be84b 100644 --- a/lib/PBot/VERSION.pm +++ b/lib/PBot/VERSION.pm @@ -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", };