mirror of https://github.com/pragma-/pbot.git
181 lines
4.5 KiB
Perl
Executable File
181 lines
4.5 KiB
Perl
Executable File
# File: Registry.pm
|
|
# Author: pragma_
|
|
#
|
|
# Purpose: Provides a centralized registry of configuration settings that can
|
|
# easily be examined and updated via set/unset commands without restarting.
|
|
|
|
package PBot::Registry;
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
use Time::HiRes qw(gettimeofday);
|
|
use Carp ();
|
|
|
|
use PBot::DualIndexHashObject;
|
|
use PBot::RegistryCommands;
|
|
|
|
sub new {
|
|
if(ref($_[1]) eq 'HASH') {
|
|
Carp::croak("Options to " . __FILE__ . " should be item/value pairs, not hash reference");
|
|
}
|
|
|
|
my ($class, %conf) = @_;
|
|
my $self = bless {}, $class;
|
|
$self->initialize(%conf);
|
|
return $self;
|
|
}
|
|
|
|
sub initialize {
|
|
my ($self, %conf) = @_;
|
|
|
|
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
|
|
my $filename = delete $conf{filename};
|
|
|
|
$self->{registry} = PBot::DualIndexHashObject->new(name => 'Registry', filename => $filename, ignore_duplicates => 1);
|
|
$self->{triggers} = {};
|
|
|
|
$self->{pbot}->{atexit}->register(sub { $self->save; return; });
|
|
|
|
PBot::RegistryCommands->new(pbot => $self->{pbot});
|
|
}
|
|
|
|
sub load {
|
|
my $self = shift;
|
|
|
|
$self->{pbot}->{logger}->log("Loading registry from " . $self->{registry}->{filename} . " ...\n");
|
|
|
|
$self->{registry}->load;
|
|
|
|
foreach my $section (keys %{ $self->{registry}->hash }) {
|
|
foreach my $item (keys %{ $self->{registry}->hash->{$section} }) {
|
|
$self->process_trigger($section, $item, $self->{registry}->hash->{$section}->{$item}->{value});
|
|
}
|
|
}
|
|
|
|
$self->{pbot}->{logger}->log("Done.\n");
|
|
}
|
|
|
|
sub save {
|
|
my $self = shift;
|
|
$self->{registry}->save;
|
|
}
|
|
|
|
sub add_default {
|
|
my ($self, $type, $section, $item, $value) = @_;
|
|
$self->add($type, $section, $item, $value, 1);
|
|
}
|
|
|
|
sub add {
|
|
my $self = shift;
|
|
my ($type, $section, $item, $value, $is_default) = @_;
|
|
|
|
$type = lc $type;
|
|
$section = lc $section;
|
|
$item = lc $item;
|
|
|
|
$self->{registry}->hash->{$section}->{$item}->{value} = $value;
|
|
$self->{registry}->hash->{$section}->{$item}->{type} = $type;
|
|
|
|
$self->process_trigger($section, $item, $value) unless $is_default;
|
|
$self->save unless $is_default;
|
|
}
|
|
|
|
sub remove {
|
|
my $self = shift;
|
|
my ($section, $item) = @_;
|
|
|
|
$section = lc $section;
|
|
|
|
delete $self->{registry}->hash->{$section}->{$item};
|
|
|
|
if(not scalar keys $self->{registry}->hash->{$section}) {
|
|
delete $self->{registry}->hash->{$section};
|
|
}
|
|
|
|
$self->save;
|
|
}
|
|
|
|
sub set_default {
|
|
my ($self, $section, $item, $key, $value) = @_;
|
|
$self->set($section, $item, $key, $value, 1);
|
|
}
|
|
|
|
sub set {
|
|
my ($self, $section, $item, $key, $value, $is_default) = @_;
|
|
|
|
$section = lc $section;
|
|
$item = lc $item;
|
|
$key = lc $key if defined $key;
|
|
|
|
my $oldvalue = $self->get_value($section, $item, 1) if defined $value;
|
|
$oldvalue = '' if not defined $oldvalue;
|
|
|
|
my $result = $self->{registry}->set($section, $item, $key, $value, 1);
|
|
|
|
if(defined $key and $key eq 'value' and defined $value and $oldvalue ne $value) {
|
|
$self->process_trigger($section, $item, $value);
|
|
}
|
|
|
|
$self->save if $result =~ m/set to/ && not $is_default;
|
|
|
|
return $result;
|
|
}
|
|
|
|
sub unset {
|
|
my ($self, $section, $item, $key) = @_;
|
|
|
|
$section = lc $section;
|
|
$item = lc $item;
|
|
$key = lc $key;
|
|
|
|
my $result = $self->{registry}->unset($section, $item, $key);
|
|
$self->save;
|
|
return $result;
|
|
}
|
|
|
|
sub get_value {
|
|
my ($self, $section, $item, $as_text) = @_;
|
|
|
|
if(exists $self->{registry}->hash->{$section} and exists $self->{registry}->hash->{$section}->{$item}) {
|
|
if(not $as_text and $self->{registry}->hash->{$section}->{$item}->{type} eq 'array') {
|
|
return split /\s*,\s*/, $self->{registry}->hash->{$section}->{$item}->{value};
|
|
} else {
|
|
return $self->{registry}->hash->{$section}->{$item}->{value};
|
|
}
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub get_array_value {
|
|
my ($self, $section, $item, $index) = @_;
|
|
|
|
if(exists $self->{registry}->hash->{$section} and exists $self->{registry}->hash->{$section}->{$item}) {
|
|
if($self->{registry}->hash->{$section}->{$item}->{type} eq 'array') {
|
|
my @array = split /\s*,\s*/, $self->{registry}->hash->{$section}->{$item}->{value};
|
|
return $array[$index >= $#array ? $#array : $index];
|
|
} else {
|
|
return $self->{registry}->hash->{$section}->{$item}->{value};
|
|
}
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub add_trigger {
|
|
my ($self, $section, $item, $subref) = @_;
|
|
|
|
$self->{triggers}->{$section}->{$item} = $subref;
|
|
}
|
|
|
|
sub process_trigger {
|
|
my $self = shift;
|
|
my ($section, $item) = @_;
|
|
|
|
if(exists $self->{triggers}->{$section} and exists $self->{triggers}->{$section}->{$item}) {
|
|
return &{ $self->{triggers}->{$section}->{$item} }(@_);
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
1;
|