From 18f2c30f82e3c7d123893f83ed3ae7434d42213a Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Wed, 22 Oct 2025 21:36:48 -0700 Subject: [PATCH] Many subcommands can now be abbreviated --- lib/PBot/Core/Commands/AntiSpam.pm | 13 +- lib/PBot/Core/Commands/BanList.pm | 9 +- lib/PBot/Core/Commands/BlackList.pm | 9 +- lib/PBot/Core/Commands/Capabilities.pm | 16 +- lib/PBot/Core/Commands/EventQueue.pm | 10 +- lib/PBot/Core/Utils/IsAbbrev.pm | 1 + lib/PBot/Plugin/ActionTrigger.pm | 9 +- lib/PBot/Plugin/Battleship.pm | 31 +-- lib/PBot/Plugin/WordMorph.pm | 315 +++++++++++++------------ lib/PBot/VERSION.pm | 2 +- 10 files changed, 213 insertions(+), 202 deletions(-) diff --git a/lib/PBot/Core/Commands/AntiSpam.pm b/lib/PBot/Core/Commands/AntiSpam.pm index bbb23544..0f87befd 100644 --- a/lib/PBot/Core/Commands/AntiSpam.pm +++ b/lib/PBot/Core/Commands/AntiSpam.pm @@ -9,6 +9,7 @@ package PBot::Core::Commands::AntiSpam; use parent 'PBot::Core::Class'; use PBot::Imports; +use PBot::Core::Utils::IsAbbrev; use Time::HiRes qw/gettimeofday/; use POSIX qw/strftime/; @@ -31,8 +32,8 @@ sub cmd_antispam($self, $context) { my $keywords = $self->{pbot}->{antispam}->{keywords}; - given ($command) { - when ($_ eq "list" or $_ eq "show") { + given (lc $command) { + when (isabbrev($_, 'list') or isabbrev($_, 'show')) { my $text = "Spam keywords:\n"; my $entries = 0; @@ -49,7 +50,7 @@ sub cmd_antispam($self, $context) { return $text; } - when ("set") { + when (isabbrev($_, 'set')) { my ($namespace, $keyword, $flag, $value) = $self->{pbot}->{interpreter}->split_args($arglist, 4); if (not defined $namespace or not defined $keyword) { @@ -103,7 +104,7 @@ sub cmd_antispam($self, $context) { return "Flag set."; } - when ("unset") { + when (isabbrev($_, 'unset')) { my ($namespace, $keyword, $flag) = $self->{pbot}->{interpreter}->split_args($arglist, 3); if (not defined $namespace or not defined $keyword or not defined $flag) { @@ -125,7 +126,7 @@ sub cmd_antispam($self, $context) { return $keywords->remove($namespace, $keyword, $flag); } - when ("add") { + when (isabbrev($_, 'add')) { my ($namespace, $keyword) = $self->{pbot}->{interpreter}->split_args($arglist, 2); if (not defined $namespace or not defined $keyword) { @@ -141,7 +142,7 @@ sub cmd_antispam($self, $context) { return "/say Added `$keyword`."; } - when ("remove") { + when (isabbrev($_, 'remove')) { my ($namespace, $keyword) = $self->{pbot}->{interpreter}->split_args($arglist, 2); if (not defined $namespace or not defined $keyword) { diff --git a/lib/PBot/Core/Commands/BanList.pm b/lib/PBot/Core/Commands/BanList.pm index fd736659..68102a56 100644 --- a/lib/PBot/Core/Commands/BanList.pm +++ b/lib/PBot/Core/Commands/BanList.pm @@ -10,6 +10,7 @@ use parent 'PBot::Core::Class'; use PBot::Imports; +use PBot::Core::Utils::IsAbbrev; use PBot::Core::MessageHistory::Constants ':all'; use Time::HiRes qw/gettimeofday/; @@ -225,8 +226,8 @@ sub cmd_ban_exempt($self, $context) { my $command = $self->{pbot}->{interpreter}->shift_arg($arglist); return "Usage: ban-exempt , where commands are: list, add, remove" if not defined $command; - given ($command) { - when ($_ eq 'list') { + given (lc $command) { + when (isabbrev($_, 'list')) { my $text = "Ban-evasion exemptions:\n"; my $entries = 0; foreach my $channel ($self->{pbot}->{banlist}->{'ban-exemptions'}->get_keys) { @@ -239,7 +240,7 @@ sub cmd_ban_exempt($self, $context) { $text .= "none" if $entries == 0; return $text; } - when ("add") { + when (isabbrev($_, 'add')) { my ($channel, $mask) = $self->{pbot}->{interpreter}->split_args($arglist, 2); return "Usage: ban-exempt add " if not defined $channel or not defined $mask; @@ -251,7 +252,7 @@ sub cmd_ban_exempt($self, $context) { $self->{pbot}->{banlist}->{'ban-exemptions'}->add($channel, $mask, $data); return "/say $mask exempted from ban-evasions in channel $channel"; } - when ("remove") { + when (isabbrev($_, 'remove')) { my ($channel, $mask) = $self->{pbot}->{interpreter}->split_args($arglist, 2); return "Usage: ban-exempt remove " if not defined $channel or not defined $mask; return $self->{pbot}->{banlist}->{'ban-exemptions'}->remove($channel, $mask); diff --git a/lib/PBot/Core/Commands/BlackList.pm b/lib/PBot/Core/Commands/BlackList.pm index d520654a..e7acb308 100644 --- a/lib/PBot/Core/Commands/BlackList.pm +++ b/lib/PBot/Core/Commands/BlackList.pm @@ -10,6 +10,7 @@ package PBot::Core::Commands::BlackList; use parent 'PBot::Core::Class'; use PBot::Imports; +use PBot::Core::Utils::IsAbbrev; sub initialize($self, %conf) { $self->{pbot}->{commands}->register(sub { $self->cmd_blacklist(@_) }, "blacklist", 1); @@ -30,8 +31,8 @@ sub cmd_blacklist($self, $context) { my $blacklist = $self->{pbot}->{blacklist}->{storage}; - given ($command) { - when ($_ eq "list" or $_ eq "show") { + given (lc $command) { + when (isabbrev($_, 'list') or isabbrev($_, 'show')) { my $blacklist = $self->{pbot}->{blacklist}->{storage}; my $text = "Blacklist:\n"; my $entries = 0; @@ -53,7 +54,7 @@ sub cmd_blacklist($self, $context) { return "/msg $context->{nick} $text"; } - when ("add") { + when (isabbrev($_, 'add')) { my ($mask, $channel) = $self->{pbot}->{interpreter}->split_args($arglist, 2); if (not defined $mask) { @@ -67,7 +68,7 @@ sub cmd_blacklist($self, $context) { return "/say $mask blacklisted in channel $channel"; } - when ("remove") { + when (isabbrev($_, 'remove')) { my ($mask, $channel) = $self->{pbot}->{interpreter}->split_args($arglist, 2); if (not defined $mask) { diff --git a/lib/PBot/Core/Commands/Capabilities.pm b/lib/PBot/Core/Commands/Capabilities.pm index cc89fae7..dc7a3f03 100644 --- a/lib/PBot/Core/Commands/Capabilities.pm +++ b/lib/PBot/Core/Commands/Capabilities.pm @@ -10,6 +10,8 @@ package PBot::Core::Commands::Capabilities; use PBot::Imports; use parent 'PBot::Core::Class'; +use PBot::Core::Utils::IsAbbrev; + sub initialize($self, %conf) { $self->{pbot}->{commands}->register(sub { $self->cmd_cap(@_) }, "cap"); } @@ -17,13 +19,13 @@ sub initialize($self, %conf) { sub cmd_cap($self, $context) { my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); - given ($command) { - when ('list') { + given (lc $command) { + when (isabbrev($_, 'list')) { my $cap = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); return $self->{pbot}->{capabilities}->list($cap); } - when ('whohas') { + when (isabbrev($_, 'whohas')) { my $cap = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); if (not defined $cap) { @@ -55,7 +57,7 @@ sub cmd_cap($self, $context) { return $result; } - when ('userhas') { + when (isabbrev($_, 'userhas')) { my ($name, $cap) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); if (not defined $name) { @@ -90,7 +92,7 @@ sub cmd_cap($self, $context) { next if $key eq '_name'; # skip internal cached metadata next if not $self->{pbot}->{capabilities}->exists($key); # skip metadata that isn't a capability - my $count = $self->{pbot}->{capabilities}->{caps}->get_keys; + my $count = $self->{pbot}->{capabilities}->{caps}->get_keys($key); if ($count > 0) { push @groups, "$key ($count cap" . ($count == 1 ? '' : 's') . ")"; @@ -109,7 +111,7 @@ sub cmd_cap($self, $context) { } } - when ('group') { + when (isabbrev($_, 'group')) { my ($cap, $subcaps) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); if (not defined $cap or not defined $subcaps) { @@ -147,7 +149,7 @@ sub cmd_cap($self, $context) { } } - when ('ungroup') { + when (isabbrev($_, 'ungroup')) { my ($cap, $subcaps) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); if (not defined $cap or not defined $subcaps) { diff --git a/lib/PBot/Core/Commands/EventQueue.pm b/lib/PBot/Core/Commands/EventQueue.pm index 3d12ca42..69cb0159 100644 --- a/lib/PBot/Core/Commands/EventQueue.pm +++ b/lib/PBot/Core/Commands/EventQueue.pm @@ -10,6 +10,8 @@ package PBot::Core::Commands::EventQueue; use PBot::Imports; use parent 'PBot::Core::Class'; +use PBot::Core::Utils::IsAbbrev; + use Time::Duration; sub initialize($self, %conf) { @@ -23,13 +25,13 @@ sub initialize($self, %conf) { sub cmd_eventqueue($self, $context) { my $usage = "Usage: eventqueue list [filter regex] | add [-repeat] | remove "; - my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); + my $command = lc $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); if (not defined $command) { return $usage; } - if ($command eq 'list') { + if (isabbrev($command, 'list')) { return "No events queued." if not $self->{pbot}->{event_queue}->count; my $result = eval { @@ -78,7 +80,7 @@ sub cmd_eventqueue($self, $context) { return $result; } - if ($command eq 'add') { + if (isabbrev($command, 'add')) { my ($duration, $command) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); if (not defined $duration or not defined $command) { @@ -105,7 +107,7 @@ sub cmd_eventqueue($self, $context) { return "Command added to event queue."; } - if ($command eq 'remove') { + if (isabbrev($command, 'remove') || isabbrev($command, 'delete')) { my ($regex) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1); return "Usage: eventqueue remove " if not defined $regex; $regex =~ s/(?{pbot}->{interpreter}->shift_arg($context->{arglist}); - given ($command) { - when ('list') { + given (lc $command) { + when (isabbrev($_, 'list')) { my $channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); if (not defined $channel) { @@ -148,7 +149,7 @@ sub cmd_actiontrigger($self, $context) { } } - when ('add') { + when (isabbrev($_, 'add')) { # TODO: use GetOpt flags instead of positional arguments my $channel; @@ -207,7 +208,7 @@ sub cmd_actiontrigger($self, $context) { } } - when ('delete') { + when (isabbrev($_, 'delete')) { my $channel; if ($context->{from} =~ m/^#/) { diff --git a/lib/PBot/Plugin/Battleship.pm b/lib/PBot/Plugin/Battleship.pm index 8ee96aa7..6669d6ba 100644 --- a/lib/PBot/Plugin/Battleship.pm +++ b/lib/PBot/Plugin/Battleship.pm @@ -28,6 +28,7 @@ package PBot::Plugin::Battleship; use parent 'PBot::Plugin::Base'; use PBot::Imports; +use PBot::Core::Utils::IsAbbrev; use Time::Duration; use Time::HiRes qw/time/; @@ -178,11 +179,11 @@ sub cmd_battleship($self, $context) { $self->{channel}, ); - given ($command) { + given (lc $command) { # help doesn't do much yet - when ('help') { + when (isabbrev($_, 'help')) { given ($arguments) { - when ('help') { + when (isabbrev($_, 'help')) { return "Seriously?"; } @@ -197,7 +198,7 @@ sub cmd_battleship($self, $context) { } # issue a challenge to begin a game - when ('challenge') { + when (isabbrev($_, 'challenge')) { if ($self->{current_state} ne 'nogame') { return "There is already a game of Battleship underway."; } @@ -223,7 +224,7 @@ sub cmd_battleship($self, $context) { } # accept a challenge - when (['accept', 'join']) { + when (isabbrev($_, 'accept') || isabbrev($_, 'join')) { if ($self->{current_state} ne 'challenge') { return "This is not the time to use `$command`."; } @@ -250,7 +251,7 @@ sub cmd_battleship($self, $context) { } # ready/unready - when (['ready', 'unready']) { + when (isabbrev($_, 'ready') || isabbrev($_, 'unready')) { if ($self->{current_state} ne 'challenge') { return "This is not the time to use `$command`."; } @@ -273,7 +274,7 @@ sub cmd_battleship($self, $context) { } # decline a challenge or forfeit/concede a game - when (['decline', 'quit', 'forfeit', 'concede']) { + when (isabbrev($_, 'decline') || isabbrev($_, 'quit') || isabbrev($_, 'forfeit') || isabbrev($_, 'concede')) { my $id = $self->get_player_id($nick, $user, $host); for (my $i = 0; $i < @{$self->{state_data}->{players}}; $i++) { @@ -294,7 +295,7 @@ sub cmd_battleship($self, $context) { return "There is nothing to $command."; } - when ('abort') { + when (isabbrev($_, 'abort')) { if (not $self->{pbot}->{users}->loggedin_admin($channel, $hostmask)) { return "$nick: Only admins may abort the game."; } @@ -310,7 +311,7 @@ sub cmd_battleship($self, $context) { return "/msg $channel $nick: The game has been aborted."; } - when (['pause', 'unpause']) { + when (isabbrev($_, 'pause') || isabbrev($_, 'unpause')) { if ($command eq 'pause') { $self->{state_data}->{paused} = $self->{PAUSED_BY_PLAYER}; } else { @@ -320,7 +321,7 @@ sub cmd_battleship($self, $context) { return "/msg $channel $nick has " . ($self->{state_data}->{paused} ? 'paused' : 'unpaused') . " the game!"; } - when ('score') { + when (isabbrev($_, 'score')) { if ($self->{current_state} ne 'move' and $self->{current_state} ne 'attack') { return "There is no Battleship score to show right now."; } @@ -329,7 +330,7 @@ sub cmd_battleship($self, $context) { return ''; } - when ('players') { + when (isabbrev($_, 'players')) { if (not @{$self->{state_data}->{players}}) { return "There are no players playing Battleship right now. Start a game with the `challenge` command!"; } @@ -338,7 +339,7 @@ sub cmd_battleship($self, $context) { return ''; } - when ('kick') { + when (isabbrev($_, 'kick')) { if (not $self->{pbot}->{users}->loggedin_admin($channel, $hostmask)) { return "$nick: Only admins may kick players from the game."; } @@ -366,7 +367,7 @@ sub cmd_battleship($self, $context) { return "$nick: $arguments isn't even in the game."; } - when ('bomb') { + when (isabbrev($_, 'bomb')) { if ($self->{current_state} ne 'move' and $self->{current_state} ne 'attack') { return "$nick: It's not time to do that now."; } @@ -427,7 +428,7 @@ sub cmd_battleship($self, $context) { return $msg; } - when (['specboard', 'board']) { + when (isabbrev($_, 'specboard') || isabbrev($_, 'board')) { if (grep { $_ eq $self->{current_state} } qw/nogame challenge genboard gameover/) { return "$nick: There is no board to show right now."; } @@ -459,7 +460,7 @@ sub cmd_battleship($self, $context) { } # this command shows the entire battlefield - when ('fullboard') { + when (isabbrev($_, 'fullboard')) { if (not $self->{pbot}->{users}->loggedin_admin($channel, $hostmask)) { return "$nick: Only admins may see the full board."; } diff --git a/lib/PBot/Plugin/WordMorph.pm b/lib/PBot/Plugin/WordMorph.pm index dd2273ac..96f1c566 100644 --- a/lib/PBot/Plugin/WordMorph.pm +++ b/lib/PBot/Plugin/WordMorph.pm @@ -10,6 +10,7 @@ package PBot::Plugin::WordMorph; use parent 'PBot::Plugin::Base'; use PBot::Imports; +use PBot::Core::Utils::IsAbbrev; use Storable; use Text::Levenshtein::XS 'distance'; @@ -56,7 +57,7 @@ sub wordmorph($self, $context) { my $channel = $context->{from}; given ($command) { - when ('neighbors') { + when (isabbrev($_, 'neighbors')) { if (!@args || @args > 1) { return 'Usage: wordmorph neighbors ; list the neighbors of a given word'; } @@ -72,7 +73,7 @@ sub wordmorph($self, $context) { return "`$args[0]` has $count neighbor" . ($count != 1 ? 's' : '') . ": " . join(', ', sort @neighbors); } - when ('check') { + when (isabbrev($_, 'check')) { if (!@args || @args > 1) { return 'Usage: wordmorph check ; check if a word exists in the Word Morph database'; } @@ -86,7 +87,7 @@ sub wordmorph($self, $context) { return "Yes, `$args[0]` is a word I know."; } - when ('hint') { + when (isabbrev($_, 'hint')) { if (not defined $self->{$channel}->{morph}) { return NO_MORPH_AVAILABLE; } @@ -149,160 +150,7 @@ sub wordmorph($self, $context) { return "Hint: " . join(' > ', @hints); } - when ('show') { - if (not defined $self->{$channel}->{morph}) { - return NO_MORPH_AVAILABLE; - } - - return "Current word morph: " . $self->show_morph_with_blanks($channel) . " (Change the word one letter at a time)"; - } - - when ('giveup') { - if (not defined $self->{$channel}->{morph}) { - return NO_MORPH_AVAILABLE; - } - - my $solution = join ' > ', @{$self->{$channel}->{morph}}; - $self->{$channel}->{morph} = undef; - return "The solution was $solution. Better luck next time."; - } - - when ('start') { - if (@args > 2) { - return "Invalid arguments; Usage: wordmorph start [steps to solve [word length]]"; - } - - my $steps = DEFAULT_STEPS; - my $length = undef; - - if (defined $args[0]) { - if ($args[0] !~ m/^[0-9]+$/ || $args[0] < MIN_STEPS || $args[0] > MAX_STEPS) { - return "Invalid number of steps `$args[0]`; must be integer >= ".MIN_STEPS." and <= ".MAX_STEPS."."; - } - - $steps = $args[0]; - } - - if (defined $args[1]) { - if ($args[1] !~ m/^[0-9]+$/ || $args[1] < MIN_WORD_LENGTH || $args[1] > MAX_WORD_LENGTH) { - return "Invalid word length `$args[1]`; must be integer >= ".MIN_WORD_LENGTH." and <= ".MAX_WORD_LENGTH."."; - } - - $length = $args[1]; - } - - return DB_UNAVAILABLE if not $self->{db}; - - my $attempts = 1000; - my $morph; - - while (--$attempts > 0) { - $morph = eval { - $self->make_morph_by_steps($self->{db}, $steps + 2, $length) - }; - - if (my $err = $@) { - next if $err eq "Too many attempts\n"; - return $err; - } - - last if @$morph; - } - - if (not @$morph) { - return "Failed to create Word Morph with given parameters, in reasonable time. Try again."; - } - - $self->set_up_new_morph($morph, $channel); - return "New word morph: " . $self->show_morph_with_blanks($channel) . " (Change the word one letter at a time)"; - } - - when ('custom') { - return "Usage: wordmorph custom ( | )" if @args != 2; - return DB_UNAVAILABLE if not $self->{db}; - - if (my $err = $self->validate_word($args[0], MIN_WORD_LENGTH, MAX_WORD_LENGTH)) { - return $err; - } - - my $morph; - - if ($args[1] =~ /^\d+$/) { - my $steps = DEFAULT_STEPS; - my $length = length $args[0]; - - if ($args[1] < MIN_STEPS || $args[1] > MAX_STEPS) { - return "Invalid number of steps `$args[1]`; must be integer >= ".MIN_STEPS." and <= ".MAX_STEPS."."; - } - - $steps = $args[1]; - - return DB_UNAVAILABLE if not $self->{db}; - - my $attempts = 100; - - while (--$attempts > 0) { - $morph = eval { - $self->make_morph_by_steps($self->{db}, $steps + 2, $length, $args[0]) - }; - - if (my $err = $@) { - next if $err eq "Too many attempts\n"; - return $err; - } - - last if @$morph; - } - - if (!$morph || !@$morph) { - return "Failed to create Word Morph with given parameters, in reasonable time. Try again."; - } - } else { - if (my $err = $self->validate_word($args[1], MIN_WORD_LENGTH, MAX_WORD_LENGTH)) { - return $err; - } - - $morph = eval { makemorph($self->{db}, $args[0], $args[1]) } or return $@; - return "Failed to find a path between `$args[0]` and `$args[1]`." if !$morph || !@$morph; - } - - $self->set_up_new_morph($morph, $channel); - return "New word morph: " . $self->show_morph_with_blanks($channel) . " (Change the word one letter at a time)"; - } - - when ('search') { - if (not @args) { - return "Usage: wordmorph search "; - } - - return DB_UNAVAILABLE if not $self->{db}; - - my @words; - - eval { - foreach my $length (keys $self->{db}->%*) { - foreach my $word (keys $self->{db}->{$length}->%*) { - - if ($word =~ m/$args[0]/) { - push @words, $word; - } - } - } - }; - - if (my $except = $@) { - $except =~ s/ at \/home.*$//; - return "Error: $except"; - } - - if (not @words) { - return "No matching words found."; - } - - return scalar @words . (@words == 1 ? ' word' : ' words') . ': ' . join(' ', @words); - } - - when ('solve') { + when (isabbrev($_, 'solve')) { if (not @args) { return "Usage: wordmorph solve "; } @@ -359,6 +207,159 @@ sub wordmorph($self, $context) { return "Correct! " . join(' > ', @solution) . " is shorter than the expected solution. Congratulations!"; } + when (isabbrev($_, 'show')) { + if (not defined $self->{$channel}->{morph}) { + return NO_MORPH_AVAILABLE; + } + + return "Current word morph: " . $self->show_morph_with_blanks($channel) . " (Change the word one letter at a time)"; + } + + when (isabbrev($_, 'giveup')) { + if (not defined $self->{$channel}->{morph}) { + return NO_MORPH_AVAILABLE; + } + + my $solution = join ' > ', @{$self->{$channel}->{morph}}; + $self->{$channel}->{morph} = undef; + return "The solution was $solution. Better luck next time."; + } + + when (isabbrev($_, 'start')) { + if (@args > 2) { + return "Invalid arguments; Usage: wordmorph start [steps to solve [word length]]"; + } + + my $steps = DEFAULT_STEPS; + my $length = undef; + + if (defined $args[0]) { + if ($args[0] !~ m/^[0-9]+$/ || $args[0] < MIN_STEPS || $args[0] > MAX_STEPS) { + return "Invalid number of steps `$args[0]`; must be integer >= ".MIN_STEPS." and <= ".MAX_STEPS."."; + } + + $steps = $args[0]; + } + + if (defined $args[1]) { + if ($args[1] !~ m/^[0-9]+$/ || $args[1] < MIN_WORD_LENGTH || $args[1] > MAX_WORD_LENGTH) { + return "Invalid word length `$args[1]`; must be integer >= ".MIN_WORD_LENGTH." and <= ".MAX_WORD_LENGTH."."; + } + + $length = $args[1]; + } + + return DB_UNAVAILABLE if not $self->{db}; + + my $attempts = 1000; + my $morph; + + while (--$attempts > 0) { + $morph = eval { + $self->make_morph_by_steps($self->{db}, $steps + 2, $length) + }; + + if (my $err = $@) { + next if $err eq "Too many attempts\n"; + return $err; + } + + last if @$morph; + } + + if (not @$morph) { + return "Failed to create Word Morph with given parameters, in reasonable time. Try again."; + } + + $self->set_up_new_morph($morph, $channel); + return "New word morph: " . $self->show_morph_with_blanks($channel) . " (Change the word one letter at a time)"; + } + + when (isabbrev($_, 'custom')) { + return "Usage: wordmorph custom ( | )" if @args != 2; + return DB_UNAVAILABLE if not $self->{db}; + + if (my $err = $self->validate_word($args[0], MIN_WORD_LENGTH, MAX_WORD_LENGTH)) { + return $err; + } + + my $morph; + + if ($args[1] =~ /^\d+$/) { + my $steps = DEFAULT_STEPS; + my $length = length $args[0]; + + if ($args[1] < MIN_STEPS || $args[1] > MAX_STEPS) { + return "Invalid number of steps `$args[1]`; must be integer >= ".MIN_STEPS." and <= ".MAX_STEPS."."; + } + + $steps = $args[1]; + + return DB_UNAVAILABLE if not $self->{db}; + + my $attempts = 100; + + while (--$attempts > 0) { + $morph = eval { + $self->make_morph_by_steps($self->{db}, $steps + 2, $length, $args[0]) + }; + + if (my $err = $@) { + next if $err eq "Too many attempts\n"; + return $err; + } + + last if @$morph; + } + + if (!$morph || !@$morph) { + return "Failed to create Word Morph with given parameters, in reasonable time. Try again."; + } + } else { + if (my $err = $self->validate_word($args[1], MIN_WORD_LENGTH, MAX_WORD_LENGTH)) { + return $err; + } + + $morph = eval { makemorph($self->{db}, $args[0], $args[1]) } or return $@; + return "Failed to find a path between `$args[0]` and `$args[1]`." if !$morph || !@$morph; + } + + $self->set_up_new_morph($morph, $channel); + return "New word morph: " . $self->show_morph_with_blanks($channel) . " (Change the word one letter at a time)"; + } + + when (isabbrev($_, 'search')) { + if (not @args) { + return "Usage: wordmorph search "; + } + + return DB_UNAVAILABLE if not $self->{db}; + + my @words; + + eval { + foreach my $length (keys $self->{db}->%*) { + foreach my $word (keys $self->{db}->{$length}->%*) { + + if ($word =~ m/$args[0]/) { + push @words, $word; + } + } + } + }; + + if (my $except = $@) { + $except =~ s/ at \/home.*$//; + return "Error: $except"; + } + + if (not @words) { + return "No matching words found."; + } + + return scalar @words . (@words == 1 ? ' word' : ' words') . ': ' . join(' ', @words); + } + default { return "Unknown command `$command`; " . USAGE; } diff --git a/lib/PBot/VERSION.pm b/lib/PBot/VERSION.pm index 7f248044..580ac624 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 => 4919, + BUILD_REVISION => 4920, BUILD_DATE => "2025-10-22", };