# File: RegistryCommands.pm # # Purpose: Bot commands to manipulate Registry entries. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT package PBot::RegistryCommands; use parent 'PBot::Class'; use PBot::Imports; sub initialize { my ($self, %conf) = @_; $self->{pbot}->{commands}->register(sub { $self->cmd_regset(@_) }, "regset", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_regunset(@_) }, "regunset", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_regshow(@_) }, "regshow", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_regsetmeta(@_) }, "regsetmeta", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_regunsetmeta(@_) }, "regunsetmeta", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_regchange(@_) }, "regchange", 1); $self->{pbot}->{commands}->register(sub { $self->cmd_regfind(@_) }, "regfind", 0); } sub cmd_regset { my ($self, $context) = @_; my $usage = "Usage: regset
. [value]"; # support "
." syntax in addition to "
" my $section = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // return $usage; my ($item, $value); if ($section =~ m/^(.+?)\.(.+)$/) { ($section, $item) = ($1, $2); ($value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1); } else { ($item, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); } if (not defined $section or not defined $item) { return $usage; } if (defined $value) { $self->{pbot}->{registry}->add('text', $section, $item, $value); } else { return $self->{pbot}->{registry}->set($section, $item, 'value'); } $self->{pbot}->{logger}->log("$context->{hostmask} set registry entry $section.$item => $value\n"); return "$section.$item set to $value"; } sub cmd_regunset { my ($self, $context) = @_; my $usage = "Usage: regunset
."; # support "
." syntax in addition to "
" my $section = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // return $usage; my $item; if ($section =~ m/^(.+?)\.(.+)$/) { ($section, $item) = ($1, $2); } else { ($item) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1); } if (not defined $section or not defined $item) { return $usage; } if (not $self->{pbot}->{registry}->{storage}->exists($section)) { return "No such registry section $section."; } if (not $self->{pbot}->{registry}->{storage}->exists($section, $item)) { return "No such item $item in section $section."; } $self->{pbot}->{logger}->log("$context->{hostmask} removed registry entry $section.$item\n"); $self->{pbot}->{registry}->remove($section, $item); return "$section.$item deleted from registry"; } sub cmd_regsetmeta { my ($self, $context) = @_; my $usage = "Usage: regsetmeta
. [key [value]]"; # support "
." syntax in addition to "
" my $section = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // return $usage; my ($item, $key, $value); if ($section =~ m/^(.+?)\.(.+)$/) { ($section, $item) = ($1, $2); ($key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); } else { ($item, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); } if (not defined $section or not defined $item) { return $usage; } $key = undef if not length $key; $value = undef if not length $value; return $self->{pbot}->{registry}->set($section, $item, $key, $value); } sub cmd_regunsetmeta { my ($self, $context) = @_; my $usage = "Usage: regunsetmeta
. "; # support "
." syntax in addition to "
" my $section = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // return $usage; my ($item, $key); if ($section =~ m/^(.+?)\.(.+)$/) { ($section, $item) = ($1, $2); ($key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1); } else { ($item, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); } if (not defined $section or not defined $item or not defined $key) { return $usage; } return $self->{pbot}->{registry}->unset($section, $item, $key); } sub cmd_regshow { my ($self, $context) = @_; my $usage = "Usage: regshow
."; my $registry = $self->{pbot}->{registry}->{storage}; # support "
." syntax in addition to "
" my $section = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}) // return $usage; my $item; if ($section =~ m/^(.+?)\.(.+)$/) { ($section, $item) = ($1, $2); } else { ($item) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1); } if (not defined $section or not defined $item) { return $usage; } if (not $registry->exists($section)) { return "No such registry section $section."; } if (not $registry->exists($section, $item)) { return "No such registry item $item in section $section."; } if ($registry->get_data($section, $item, 'private')) { return "$section.$item: "; } my $result = "$section.$item: " . $registry->get_data($section, $item, 'value'); if ($registry->get_data($section, $item, 'type') eq 'array') { $result .= ' [array]'; } return $result; } sub cmd_regfind { my ($self, $context) = @_; my $usage = "Usage: regfind [-showvalues] [-section section] "; my $registry = $self->{pbot}->{registry}->{storage}; my $arguments = $context->{arguments}; return $usage if not defined $arguments; # TODO maybe use GetOptionsFromArray here my ($section, $showvalues); $section = $1 if $arguments =~ s/-section\s+([^\b\s]+)//i; $showvalues = 1 if $arguments =~ s/-showvalues?//i; $arguments =~ s/^\s+|\s+$//g; $arguments =~ s/\s+/ /g; return $usage if not length $arguments; $section = lc $section if defined $section; my ($text, $last_item, $last_section, $count); $last_section = ''; $count = 0; eval { use re::engine::RE2 -strict => 1; # prevent user-defined regex from exploding foreach my $section_key (sort $registry->get_keys) { next if defined $section and $section_key ne $section; foreach my $item_key (sort $registry->get_keys($section_key)) { next if $item_key eq '_name'; # skip internal cached value if ($registry->get_data($section_key, $item_key, 'private')) { # if private, match on key only -- do not match on value next if $item_key !~ /$arguments/i; } else { # otherwise check for match on key and value next if $item_key !~ /$arguments/i and $registry->get_data($section_key, $item_key, 'value') !~ /$arguments/i; } $count++; if ($section_key ne $last_section) { $text .= "[$section_key]\n"; $last_section = $section_key; } if ($showvalues) { if ($registry->get_data($section_key, $item_key, 'private')) { $text .= " $item_key = \n"; } else { $text .= " $item_key = " . $registry->get_data($section_key, $item_key, 'value') . ($registry->get_data($section_key, $item_key, 'type') eq 'array' ? " [array]\n" : "\n"); } } else { $text .= " $item_key\n"; } $last_item = $item_key; } } }; return "/msg $context->{nick} $context->{arguments}: $@" if $@; if ($count == 1) { chomp $text; if ($registry->get_data($last_section, $last_item, 'private')) { return "Found one registry entry: [$last_section] $last_item: "; } else { return "Found one registry entry: [$last_section] $last_item: " . $registry->get_data($last_section, $last_item, 'value') . ($registry->get_data($last_section, $last_item, 'type') eq 'array' ? ' [array]' : ''); } } elsif ($count > 1) { return "Found $count registry entries:\n$text"; } else { my $sections = (defined $section ? "section $section" : 'any sections'); return "No matching registry entries found in $sections."; } } sub cmd_regchange { my ($self, $context) = @_; my ($section, $item, $delim, $tochange, $changeto, $modifier); my $arguments = $context->{arguments}; if (length $arguments) { if ($arguments =~ /^(.+?)\.([^\s]+)\s+s(.)/ or $arguments =~ /^([^\s]+) ([^\s]+)\s+s(.)/) { $section = $1; $item = $2; $delim = $3; } if ($arguments =~ /$delim(.*?)$delim(.*)$delim(.*)?$/) { $tochange = $1; $changeto = $2; $modifier = $3; } } if (not defined $section or not defined $item or not defined $changeto) { return "Usage: regchange
. s///"; } $section = lc $section; $item = lc $item; my $registry = $self->{pbot}->{registry}->{storage}; if (not $registry->exists($section)) { return "No such registry section $section."; } if (not $registry->exists($section, $item)) { return "No such registry item $item in section $section."; } my $result = eval { use re::engine::RE2 -strict => 1; # prevent user-defined regex from exploding my $value = $registry->get_data($section, $item, 'value'); if (not $value =~ s|$tochange|$changeto|) { $self->{pbot}->{logger}->log("($context->{from}) $context->{hostmask}: failed to change $section.$item 's$delim$tochange$delim$changeto$delim$modifier\n"); return "/msg $context->{nick} Change $section.$item failed."; } else { $registry->set($section, $item, 'value', $value, 1); $self->{pbot}->{logger}->log("($context->{from}) $context->{hostmask}: changed $section.$item 's/$tochange/$changeto/\n"); $self->{pbot}->{registry}->process_trigger($section, $item, 'value', $value); $self->{pbot}->{registry}->save; return "$section.$item set to $value"; } }; return "/msg $context->{nick} Failed to change $section.$item: $@" if $@; return $result; } 1;