From 3219c3d008da62e6afeefda717083e1ef3f72964 Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Thu, 25 Sep 2025 01:14:10 -0700 Subject: [PATCH] Improve code-factoids - now processes command substitutions, pipes, and splits - indentation and newlines preserved --- lib/PBot/Core/Factoids/Code.pm | 2 +- lib/PBot/Core/Factoids/Interpreter.pm | 18 ++- lib/PBot/Core/Interpreter.pm | 167 +++++++++++++++----------- lib/PBot/Core/ProcessManager.pm | 28 ++++- lib/PBot/VERSION.pm | 2 +- 5 files changed, 137 insertions(+), 80 deletions(-) diff --git a/lib/PBot/Core/Factoids/Code.pm b/lib/PBot/Core/Factoids/Code.pm index 9b2e4aab..24e468d7 100644 --- a/lib/PBot/Core/Factoids/Code.pm +++ b/lib/PBot/Core/Factoids/Code.pm @@ -70,7 +70,7 @@ sub execute($self, $context) { my $json = encode_json \%args; # update context details - $context->{special} = 'code-factoid'; # ensure handle_result(), etc, process this as a code-factoid + $context->{special}->{$context->{stack_depth}} = 'code-factoid'; # ensure handle_result(), etc, process this as a code-factoid $context->{root_channel} = $context->{channel}; # override root channel to current channel $context->{keyword} = 'vm-client'; # code-factoid uses `vm-client` command to invoke vm $context->{arguments} = $json; # set arguments to json string as `vm-client` expects diff --git a/lib/PBot/Core/Factoids/Interpreter.pm b/lib/PBot/Core/Factoids/Interpreter.pm index 1959e573..e62e0711 100644 --- a/lib/PBot/Core/Factoids/Interpreter.pm +++ b/lib/PBot/Core/Factoids/Interpreter.pm @@ -388,7 +388,7 @@ sub handle_action($self, $context, $action) { unless ($self->{pbot}->{factoids}->{data}->{storage}->get_data($channel, $keyword, 'require_explicit_args')) { my $args = $context->{arguments}; - $command .= " $args" if length $args and not $context->{special} eq 'code-factoid'; + $command .= " $args" if length $args and not $context->{special}->{$context->{stack_depth}} eq 'code-factoid'; $context->{arguments} = ''; } @@ -448,14 +448,20 @@ sub handle_action($self, $context, $action) { } # action is a code factoid - if ($action =~ m{^/code\s+([^\s]+)\s+(.+)$}msi) { + if ($action =~ m{^/code\s+(\S+)\s+(.+)$}msi) { my ($lang, $code) = ($1, $2); - $context->{lang} = $lang; - $context->{code} = $code; - return $self->{pbot}->{factoids}->{code}->execute($context); + my $depth = $context->{stack_depth}; + $context->{code_args}->{$depth} = $context->{arguments}; + $context->{special}->{$depth} = 'code-factoid'; + $context->{command} = "/code $lang $code"; + return $self->{pbot}->{interpreter}->interpret($context); } - return $action if $context->{special} eq 'code-factoid'; + if ($context->{special}->{$context->{stack_depth}} eq 'code-factoid') { + # code-factoid completed + delete $context->{special}->{$context->{stack_depth}}; + return $action; + } if ($self->{pbot}->{factoids}->{data}->{storage}->get_data($channel, $keyword, 'type') eq 'applet') { $context->{root_keyword} = $keyword unless defined $context->{root_keyword}; diff --git a/lib/PBot/Core/Interpreter.pm b/lib/PBot/Core/Interpreter.pm index 0a9f0dc9..1bab941c 100644 --- a/lib/PBot/Core/Interpreter.pm +++ b/lib/PBot/Core/Interpreter.pm @@ -154,11 +154,11 @@ sub process_line($self, $from, $nick, $user, $host, $text, $tags = '', $is_comma # "!command" $command = $1; $context->{addressed} = 1; # command explicitly invoked - } elsif ($cmd_text =~ m/^.?\s*$botnick\s*[,:]\s+(.+)$/i) { + } elsif ($cmd_text =~ m/^$botnick\s*[,:]\s+(.+)$/i) { # "botnick: command" $command = $1; $context->{addressed} = 1; # command explicitly invoked - } elsif ($cmd_text =~ m/^.?\s*$botnick\s+(.+)$/i) { + } elsif ($cmd_text =~ m/^$botnick\s+(.+)$/i) { # "botnick command" $command = $1; $context->{addressed} = 0; # command NOT explicitly invoked (silence disambig/errors) @@ -261,6 +261,9 @@ sub process_line($self, $from, $nick, $user, $host, $text, $tags = '', $is_comma delete $context->{pipe}; delete $context->{pipe_next}; delete $context->{add_nick}; + delete $context->{special}; + delete $context->{code}; + delete $context->{lang}; } # return number of commands processed @@ -279,11 +282,10 @@ sub interpret($self, $context) { # debug flag to trace $context location and contents if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { use Data::Dumper; - $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] }; + $Data::Dumper::Sortkeys = 1; $Data::Dumper::Indent = 2; $self->{pbot}->{logger}->log("Interpreter::interpret\n"); $self->{pbot}->{logger}->log(Dumper $context); - $Data::Dumper::Sortkeys = 1; } # enforce recursion limit @@ -310,11 +312,6 @@ sub interpret($self, $context) { $context->{cmdlist} = $cmdlist; - # create context command history if non-existent - if (not exists $context->{commands}) { - $context->{commands} = []; - } - # add command to context command history push @{$context->{commands}}, $context->{command}; @@ -341,7 +338,7 @@ sub interpret($self, $context) { $recipient = $cmdlist->[1]; } else { # normal command, split into keywords and arguments while preserving quotes - ($keyword, $arguments) = $self->split_args($cmdlist, 2, 0, 1); + ($keyword, $arguments) = $context->{command} =~ m/^\s*(\S+)\s*(.*)$/ms; } # limit keyword length (in bytes) @@ -382,66 +379,77 @@ sub interpret($self, $context) { } } - # find factoid channel for dont-replace-pronouns metadata - my ($fact_channel, $fact_trigger); - my @factoids = $self->{pbot}->{factoids}->{data}->find($context->{from}, $keyword, exact_trigger => 1); + my $special = $context->{special}->{$context->{stack_depth}}; - if (@factoids == 1) { - # found the factoid's channel - ($fact_channel, $fact_trigger) = @{$factoids[0]}; - } else { - # match the factoid in the current channel if it exists - foreach my $f (@factoids) { - if ($f->[0] eq $context->{from}) { - ($fact_channel, $fact_trigger) = ($f->[0], $f->[1]); - last; + if (not $special) { + if ($keyword =~ m,^/,) { + $special = $keyword; + } + } + + my ($fact_channel, $fact_trigger); + + unless ($special) { + # find factoid channel for dont-replace-pronouns metadata + my @factoids = $self->{pbot}->{factoids}->{data}->find($context->{from}, $keyword, exact_trigger => 1); + + if (@factoids == 1) { + # found the factoid's channel + ($fact_channel, $fact_trigger) = @{$factoids[0]}; + } else { + # match the factoid in the current channel if it exists + foreach my $f (@factoids) { + if ($f->[0] eq $context->{from}) { + ($fact_channel, $fact_trigger) = ($f->[0], $f->[1]); + last; + } + } + + # and otherwise assume global if it doesn't exist (FIXME: what to do if there isn't a global one?) + if (not defined $fact_channel) { + ($fact_channel, $fact_trigger) = ('.*', $keyword); } } - # and otherwise assume global if it doesn't exist (FIXME: what to do if there isn't a global one?) - if (not defined $fact_channel) { - ($fact_channel, $fact_trigger) = ('.*', $keyword); - } - } - - if ($self->{pbot}->{commands}->get_meta($keyword, 'suppress-no-output') - or $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'suppress-no-output')) - { - $context->{'suppress_no_output'} = 1; - } else { - delete $context->{'suppress_no_output'}; - } - - if ($self->{pbot}->{commands}->get_meta($keyword, 'dont-replace-pronouns') - or $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'dont-replace-pronouns')) - { - $context->{'dont-replace-pronouns'} = 1; - } - - # replace pronouns like "i", "my", etc, with "nick", "nick's", etc - if (not $context->{'dont-replace-pronouns'}) { - # if command recipient is "me" then replace it with invoker's nick - # e.g., "!tell me about date" or "!give me date", etc - if (defined $context->{nickprefix} and lc $context->{nickprefix} eq 'me') { - $context->{nickprefix} = $context->{nick}; + if ($self->{pbot}->{commands}->get_meta($keyword, 'suppress-no-output') + or $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'suppress-no-output')) + { + $context->{'suppress_no_output'} = 1; + } else { + delete $context->{'suppress_no_output'}; } - # strip trailing sentence-ending punctuators from $keyword - # TODO: why are we doing this? why here? why at all? - $keyword =~ s/(\w+)[?!.]+$/$1/; + if ($self->{pbot}->{commands}->get_meta($keyword, 'dont-replace-pronouns') + or $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'dont-replace-pronouns')) + { + $context->{'dont-replace-pronouns'} = 1; + } - # replace pronouns in $arguments. - # but only on the top-level command (not on subsequent recursions). - # all pronouns can be escaped to prevent replacement, e.g. "!give \me date" - if (length $arguments and $context->{interpret_depth} <= 1) { - $arguments =~ s/(?{nick} is/gi; - $arguments =~ s/(?{nick}/gi; - $arguments =~ s/(?{nick}'s/gi; + # replace pronouns like "i", "my", etc, with "nick", "nick's", etc + if (not $context->{'dont-replace-pronouns'}) { + # if command recipient is "me" then replace it with invoker's nick + # e.g., "!tell me about date" or "!give me date", etc + if (defined $context->{nickprefix} and lc $context->{nickprefix} eq 'me') { + $context->{nickprefix} = $context->{nick}; + } - # unescape any escaped pronouns - $arguments =~ s/\\i am\b/i am/gi; - $arguments =~ s/\\my\b/my/gi; - $arguments =~ s/\\me\b/me/gi; + # strip trailing sentence-ending punctuators from $keyword + # TODO: why are we doing this? why here? why at all? + $keyword =~ s/(\w+)[?!.]+$/$1/; + + # replace pronouns in $arguments. + # but only on the top-level command (not on subsequent recursions). + # all pronouns can be escaped to prevent replacement, e.g. "!give \me date" + if (length $arguments and $context->{interpret_depth} <= 1) { + $arguments =~ s/(?{nick} is/gi; + $arguments =~ s/(?{nick}/gi; + $arguments =~ s/(?{nick}'s/gi; + + # unescape any escaped pronouns + $arguments =~ s/\\i am\b/i am/gi; + $arguments =~ s/\\my\b/my/gi; + $arguments =~ s/\\me\b/me/gi; + } } } @@ -515,8 +523,8 @@ sub interpret($self, $context) { # the bot doesn't like performing bot commands on itself # unless dont-protect-self is true - if (not $self->{pbot}->{commands}->get_meta($keyword, 'dont-protect-self') - and not $self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'dont-protect-self')) + if (!$special && !$self->{pbot}->{commands}->get_meta($keyword, 'dont-protect-self') + && !$self->{pbot}->{factoids}->{data}->get_meta($fact_channel, $fact_trigger, 'dont-protect-self')) { my $botnick = $self->{pbot}->{conn}->nick; @@ -550,6 +558,16 @@ sub interpret($self, $context) { } } + # if code factoid, let handle_action finish up substitutions, pipes, + # splits, etc, and then invoke the code factoid without updating + # $context's keyword or arguments + if ($keyword eq '/code') { + # there is no result yet until code factoid is invoked + # right now we're just finishing up substitions, pipes, etc + $context->{'code-factoid'} = 1; + return ''; + } + # set the contextual root root keyword. # this is the keyword first used to invoke this command. it is not updated # on subsequent command interpreter recursions. @@ -577,7 +595,7 @@ sub interpret($self, $context) { delete $context->{args_utf8}; # reset the special behavior - $context->{special} = ''; + $context->{special}->{$context->{stack_depth}} = ''; # execute all registered interpreters my $result; @@ -612,12 +630,24 @@ sub handle_result($self, $context, $result = $context->{result}) { # debug flag to trace $context location and contents if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { use Data::Dumper; - $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] }; + $Data::Dumper::Sortkeys = 1; $Data::Dumper::Indent = 2; $self->{pbot}->{logger}->log("Interpreter::handle_result [$result]\n"); $self->{pbot}->{logger}->log(Dumper $context); } + if ($context->{'code-factoid'}) { + delete $context->{'code-factoid'}; # code-factoid handled + # execute code factoid + if ($context->{command} =~ m/^\/code (\S+) (.*)/ms) { + $context->{lang} = $1; + $context->{code} = $2; + $context->{arguments} = $context->{code_args}->{$context->{stack_depth}}; + # ProcessManager's process pipe reader will handle the result + return $self->{pbot}->{factoids}->{code}->execute($context); + } + } + # ensure we have a command result to work with if (!defined $result || $context->{'skip-handle-result'}) { $self->{pbot}->{logger}->log("Skipping handle_result\n"); @@ -885,11 +915,10 @@ sub output_result($self, $context) { # debug flag to trace $context location and contents if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { use Data::Dumper; - $Data::Dumper::Sortkeys = sub { [sort grep { not /(?:cmdlist|arglist)/ } keys %$context] }; + $Data::Dumper::Sortkeys = 1; $Data::Dumper::Indent = 2; $self->{pbot}->{logger}->log("Interpreter::output_result\n"); $self->{pbot}->{logger}->log(Dumper $context); - $Data::Dumper::Sortkeys = 1; } my $output = $context->{output}; @@ -1341,7 +1370,7 @@ sub split_line($self, $line, %opts) { $token .= $ch; next; } else { - if ($opts{keep_spaces} && $ch eq "\n") { + if ($opts{keep_spaces} && ($ch eq "\n" || $ch eq "\t")) { $token .= $ch; } diff --git a/lib/PBot/Core/ProcessManager.pm b/lib/PBot/Core/ProcessManager.pm index d8b9743f..f98421d9 100644 --- a/lib/PBot/Core/ProcessManager.pm +++ b/lib/PBot/Core/ProcessManager.pm @@ -51,7 +51,16 @@ sub remove_process($self, $pid) { } sub execute_process($self, $context, $subref, $timeout = undef, $reader_subref = undef) { - # don't fork again if we're already a forked process + # debug flag to trace $context location and contents + if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { + use Data::Dumper; + $Data::Dumper::Indent = 2; + $Data::Dumper::Sortkeys = 1; + $self->{pbot}->{logger}->log("ProcessManager::execute_process\n"); + $self->{pbot}->{logger}->log(Dumper $context); + } + + # don't fork again if we're already child if (defined $context->{pid} and $context->{pid} == 0) { $self->{pbot}->{logger}->log("execute_process: Re-using PID $context->{pid} for new process\n"); $subref->($context); @@ -63,6 +72,8 @@ sub execute_process($self, $context, $subref, $timeout = undef, $reader_subref = # fork new process $context->{pid} = fork; + $self->{pbot}->{logger}->log("=-=-=-=-=-=-= FORK PID $context->{pid} =-=-=-=-=-=-=-=\n"); + if (not defined $context->{pid}) { # fork failed $self->{pbot}->{logger}->log("Could not fork process: $!\n"); @@ -143,10 +154,19 @@ sub execute_process($self, $context, $subref, $timeout = undef, $reader_subref = sub process_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"); + $self->{pbot}->{logger}->log("ProcessManager::process_pipe_reader: Failed to decode bad json: [$buf]\n"); return; }; + # debug flag to trace $context location and contents + if ($self->{pbot}->{registry}->get_value('general', 'debugcontext')) { + use Data::Dumper; + $Data::Dumper::Indent = 2; + $Data::Dumper::Sortkeys = 1; + $self->{pbot}->{logger}->log("ProcessManager::process_pipe_reader ($pid)\n"); + $self->{pbot}->{logger}->log(Dumper $context); + } + # context is no longer forked delete $context->{pid}; @@ -165,8 +185,10 @@ sub process_pipe_reader($self, $pid, $buf) { return if $context->{result} =~ m/(?:no results)/i; } + $self->{pbot}->{logger}->log("process pipe handling result [$context->{result}]\n"); + # handle code factoid result - if (exists $context->{special} and $context->{special} eq 'code-factoid') { + if (exists $context->{special} and $context->{special}->{$context->{stack_depth}} eq 'code-factoid') { $context->{result} =~ s/\s+$//g; $context->{original_keyword} = $context->{root_keyword}; $context->{result} = $self->{pbot}->{factoids}->{interpreter}->handle_action($context, $context->{result}); diff --git a/lib/PBot/VERSION.pm b/lib/PBot/VERSION.pm index 76ad96e0..9e55fcc9 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 => 4894, + BUILD_REVISION => 4895, BUILD_DATE => "2025-09-25", };