mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-09 13:39:34 +01:00
ea63ef8fe8
Storage-related packages have been moved to PBot/Storage/. MessageHistory_SQLite.pm has been moved to MessageHistory/Storage/SQLite.pm. Quotegrabs' storage packages have been moved to Plugin/Quotegrabs/Storage/. IRC handler-related packages have been moved to PBot/IRCHandlers/. Commands registered by core PBot packages have been moved to PBot/Commands/. Some non-core packages have been moved to PBot/Utils/. Several packages have been cleaned up. TODO: Move remaining core commands and IRC handlers. TODO: Split AntiFlood.pm into Plugin/AntiAbuse/ files.
339 lines
11 KiB
Perl
339 lines
11 KiB
Perl
# File: Registry.pm
|
|
#
|
|
# Purpose: Bot commands to manipulate Registry entries.
|
|
|
|
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
|
# SPDX-License-Identifier: MIT
|
|
|
|
package PBot::Commands::Registry;
|
|
|
|
use PBot::Imports;
|
|
|
|
sub new {
|
|
my ($class, %args) = @_;
|
|
|
|
# ensure class was passed a PBot instance
|
|
if (not exists $args{pbot}) {
|
|
Carp::croak("Missing pbot reference to $class");
|
|
}
|
|
|
|
my $self = bless { pbot => $args{pbot} }, $class;
|
|
$self->initialize(%args);
|
|
return $self;
|
|
}
|
|
|
|
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 <section>.<item> [value]";
|
|
|
|
# support "<section>.<key>" syntax in addition to "<section> <key>"
|
|
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 <section>.<item>";
|
|
|
|
# support "<section>.<key>" syntax in addition to "<section> <key>"
|
|
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 <section>.<item> [key [value]]";
|
|
|
|
# support "<section>.<key>" syntax in addition to "<section> <key>"
|
|
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 <section>.<item> <key>";
|
|
|
|
# support "<section>.<key>" syntax in addition to "<section> <key>"
|
|
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 <section>.<item>";
|
|
my $registry = $self->{pbot}->{registry}->{storage};
|
|
|
|
# support "<section>.<key>" syntax in addition to "<section> <key>"
|
|
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: <private>";
|
|
}
|
|
|
|
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] <regex>";
|
|
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 = <private>\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: <private>";
|
|
} 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 <section>.<item> s/<pattern>/<replacement>/";
|
|
}
|
|
|
|
$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;
|