3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-10-31 17:19:30 +01:00
pbot/PBot/RegistryCommands.pm

315 lines
10 KiB
Perl

# File: RegistryCommands.pm
# Author: pragma_
#
# Purpose: Commands to introspect and update Registry
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::RegistryCommands;
use warnings;
use strict;
use feature 'unicode_strings';
use Carp ();
sub new {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref($_[1]) eq 'HASH';
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
$self->{pbot}->{commands}->register(sub { $self->regset(@_) }, "regset", 1);
$self->{pbot}->{commands}->register(sub { $self->regunset(@_) }, "regunset", 1);
$self->{pbot}->{commands}->register(sub { $self->regshow(@_) }, "regshow", 0);
$self->{pbot}->{commands}->register(sub { $self->regsetmeta(@_) }, "regsetmeta", 1);
$self->{pbot}->{commands}->register(sub { $self->regunsetmeta(@_) }, "regunsetmeta", 1);
$self->{pbot}->{commands}->register(sub { $self->regchange(@_) }, "regchange", 1);
$self->{pbot}->{commands}->register(sub { $self->regfind(@_) }, "regfind", 0);
}
sub regset {
my $self = shift;
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my $usage = "Usage: regset <section>.<item> [value]";
# support "<section>.<key>" syntax in addition to "<section> <key>"
my $section = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // return $usage;
my ($item, $value);
if ($section =~ m/^(.+?)\.(.+)$/) {
($section, $item) = ($1, $2);
($value) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1);
} else {
($item, $value) = $self->{pbot}->{interpreter}->split_args($stuff->{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("$nick!$user\@$host set registry entry [$section] $item => $value\n");
return "$section.$item set to $value";
}
sub regunset {
my $self = shift;
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my $usage = "Usage: regunset <section>.<item>";
# support "<section>.<key>" syntax in addition to "<section> <key>"
my $section = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // return $usage;
my $item;
if ($section =~ m/^(.+?)\.(.+)$/) {
($section, $item) = ($1, $2);
} else {
($item) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1);
}
if (not defined $section or not defined $item) {
return $usage;
}
$section = lc $section;
$item = lc $item;
if (not exists $self->{pbot}->{registry}->{registry}->{hash}->{$section}) {
return "No such registry section $section.";
}
if (not exists $self->{pbot}->{registry}->{registry}->{hash}->{$section}->{$item}) {
return "No such item $item in section $section.";
}
$self->{pbot}->{logger}->log("$nick!$user\@$host removed registry entry $section.$item\n");
$self->{pbot}->{registry}->remove($section, $item);
return "$section.$item deleted from registry";
}
sub regsetmeta {
my $self = shift;
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my $usage = "Usage: regsetmeta <section>.<item> [key [value]]";
# support "<section>.<key>" syntax in addition to "<section> <key>"
my $section = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // return $usage;
my ($item, $key, $value);
if ($section =~ m/^(.+?)\.(.+)$/) {
($section, $item) = ($1, $2);
($key, $value) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 2);
} else {
($item, $key, $value) = $self->{pbot}->{interpreter}->split_args($stuff->{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 regunsetmeta {
my $self = shift;
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my $usage = "Usage: regunsetmeta <section>.<item> <key>";
# support "<section>.<key>" syntax in addition to "<section> <key>"
my $section = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // return $usage;
my ($item, $key);
if ($section =~ m/^(.+?)\.(.+)$/) {
($section, $item) = ($1, $2);
($key) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1);
} else {
($item, $key) = $self->{pbot}->{interpreter}->split_args($stuff->{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 regshow {
my $self = shift;
my ($from, $nick, $user, $host, $arguments, $stuff) = @_;
my $registry = $self->{pbot}->{registry}->{registry}->{hash};
my $usage = "Usage: regshow <section>.<item>";
# support "<section>.<key>" syntax in addition to "<section> <key>"
my $section = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist}) // return $usage;
my $item;
if ($section =~ m/^(.+?)\.(.+)$/) {
($section, $item) = ($1, $2);
} else {
($item) = $self->{pbot}->{interpreter}->split_args($stuff->{arglist}, 1);
}
if (not defined $section or not defined $item) {
return $usage;
}
$section = lc $section;
$item = lc $item;
if (not exists $registry->{$section}) {
return "No such registry section $section.";
}
if (not exists $registry->{$section}->{$item}) {
return "No such registry item $item in section $section.";
}
if ($registry->{$section}->{$item}->{private}) {
return "$section.$item: <private>";
}
my $result = "$section.$item: $registry->{$section}->{$item}->{value}";
if ($registry->{$section}->{$item}->{type} eq 'array') {
$result .= ' [array]';
}
return $result;
}
sub regfind {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my $registry = $self->{pbot}->{registry}->{registry}->{hash};
my $usage = "Usage: regfind [-showvalues] [-section section] <regex>";
return $usage if not defined $arguments;
my ($section, $showvalues);
$section = $1 if $arguments =~ s/-section\s+([^\b\s]+)//i;
$showvalues = 1 if $arguments =~ s/-showvalues?//i;
$arguments =~ s/^\s+//;
$arguments =~ s/\s+$//;
$arguments =~ s/\s+/ /g;
return $usage if $arguments eq "";
$section = lc $section if defined $section;;
my ($text, $last_item, $last_section, $i);
$last_section = "";
$i = 0;
eval {
use re::engine::RE2 -strict => 1;
foreach my $section_key (sort keys %{ $registry }) {
next if defined $section and $section_key ne $section;
foreach my $item_key (sort keys %{ $registry->{$section_key} }) {
next if $item_key eq '_name';
if ($registry->{$section_key}->{$item_key}->{private}) {
# do not match on value if private
next if $item_key !~ /$arguments/i;
} else {
next if $registry->{$section_key}->{$item_key}->{value} !~ /$arguments/i and $item_key !~ /$arguments/i;
}
$i++;
if ($section_key ne $last_section) {
$text .= "[$section_key]\n";
$last_section = $section_key;
}
if ($showvalues) {
if ($registry->{$section_key}->{$item_key}->{private}) {
$text .= " $item_key = <private>\n";
} else {
$text .= " $item_key = $registry->{$section_key}->{$item_key}->{value}" . ($registry->{$section_key}->{$item_key}->{type} eq 'array' ? " [array]\n" : "\n");
}
} else {
$text .= " $item_key\n";
}
$last_item = $item_key;
}
}
};
return "/msg $nick $arguments: $@" if $@;
if ($i == 1) {
chop $text;
if ($registry->{$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->{$last_section}->{$last_item}->{value}" . ($registry->{$last_section}->{$last_item}->{type} eq 'array' ? ' [array]' : '');
}
} else {
return "Found $i registry entries:\n$text" unless $i == 0;
my $sections = (defined $section ? "section $section" : 'any sections');
return "No matching registry entries found in $sections.";
}
}
sub regchange {
my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_;
my ($section, $item, $delim, $tochange, $changeto, $modifier);
if (defined $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}->{registry}->{hash};
if (not exists $registry->{$section}) {
return "No such registry section $section.";
}
if (not exists $registry->{$section}->{$item}) {
return "No such registry item $item in section $section.";
}
my $ret = eval {
use re::engine::RE2 -strict => 1;
if (not $registry->{$section}->{$item}->{value} =~ s|$tochange|$changeto|) {
$self->{pbot}->{logger}->log("($from) $nick!$user\@$host: failed to change $section.$item 's$delim$tochange$delim$changeto$delim$modifier\n");
return "/msg $nick Change $section.$item failed.";
} else {
$self->{pbot}->{logger}->log("($from) $nick!$user\@$host: changed $section.$item 's/$tochange/$changeto/\n");
$self->{pbot}->{registry}->process_trigger($section, $item, 'value', $registry->{$section}->{$item}->{value});
$self->{pbot}->{registry}->save;
return "$section.$item set to $registry->{$section}->{$item}->{value}";
}
};
return "/msg $nick Failed to change $section.$item: $@" if $@;
return $ret;
}
1;