mirror of
https://github.com/pragma-/pbot.git
synced 2024-10-31 17:19:30 +01:00
256 lines
7.7 KiB
Perl
256 lines
7.7 KiB
Perl
# File: HashObject.pm
|
|
# Author: pragma_
|
|
#
|
|
# Purpose: Provides a hash-table object with an abstracted API that includes
|
|
# setting and deleting values, saving to and loading from files, etc. Provides
|
|
# case-insensitive access to the index key while preserving original case when
|
|
# displaying index key.
|
|
|
|
# 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::HashObject;
|
|
|
|
use warnings; use strict;
|
|
use feature 'unicode_strings';
|
|
use utf8;
|
|
|
|
use Text::Levenshtein qw(fastdistance);
|
|
use JSON;
|
|
|
|
sub new {
|
|
my ($proto, %conf) = @_;
|
|
my $class = ref($proto) || $proto;
|
|
my $self = bless {}, $class;
|
|
Carp::croak("Missing pbot reference to " . __FILE__) unless exists $conf{pbot};
|
|
$self->{pbot} = $conf{pbot};
|
|
$self->initialize(%conf);
|
|
return $self;
|
|
}
|
|
|
|
sub initialize {
|
|
my ($self, %conf) = @_;
|
|
$self->{name} = $conf{name} // 'hash object';
|
|
$self->{filename} = $conf{filename} // Carp::carp("Missing filename to HashObject, will not be able to save to or load from file.");
|
|
$self->{hash} = {};
|
|
}
|
|
|
|
sub load {
|
|
my $self = shift;
|
|
my $filename;
|
|
if (@_) { $filename = shift; }
|
|
else { $filename = $self->{filename}; }
|
|
|
|
$self->clear;
|
|
|
|
if (not defined $filename) {
|
|
Carp::carp "No $self->{name} filename specified -- skipping loading from file";
|
|
return;
|
|
}
|
|
|
|
$self->{pbot}->{logger}->log("Loading $self->{name} from $filename\n");
|
|
|
|
if (not open(FILE, "< $filename")) {
|
|
$self->{pbot}->{logger}->log("Skipping loading from file: Couldn't open $filename: $!\n");
|
|
return;
|
|
}
|
|
|
|
my $contents = do {
|
|
local $/;
|
|
<FILE>;
|
|
};
|
|
|
|
$self->{hash} = decode_json $contents;
|
|
close FILE;
|
|
|
|
# update existing entries to use _name to preserve case
|
|
# and lowercase any non-lowercased entries
|
|
foreach my $index (keys %{$self->{hash}}) {
|
|
if (not exists $self->{hash}->{$index}->{_name}) {
|
|
if ($index ne lc $index) {
|
|
if (exists $self->{hash}->{lc $index}) {
|
|
Carp::croak "Cannot update $self->{name} object $index; duplicate object found";
|
|
}
|
|
|
|
my $data = delete $self->{hash}->{$index};
|
|
$data->{_name} = $index;
|
|
$self->{hash}->{lc $index} = $data;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub save {
|
|
my $self = shift;
|
|
my $filename;
|
|
if (@_) { $filename = shift; }
|
|
else { $filename = $self->{filename}; }
|
|
|
|
if (not defined $filename) {
|
|
Carp::carp "No $self->{name} filename specified -- skipping saving to file.\n";
|
|
return;
|
|
}
|
|
|
|
$self->{pbot}->{logger}->log("Saving $self->{name} to $filename\n");
|
|
|
|
if (not $self->get_data('$metadata$', 'update_version')) {
|
|
$self->add('$metadata$', { update_version => PBot::VERSION::BUILD_REVISION });
|
|
}
|
|
|
|
$self->set('$metadata$', 'name', $self->{name}, 1);
|
|
|
|
my $json = JSON->new;
|
|
my $json_text = $json->pretty->canonical->utf8->encode($self->{hash});
|
|
|
|
open(FILE, "> $filename") or die "Couldn't open $filename: $!\n";
|
|
print FILE "$json_text\n";
|
|
close(FILE);
|
|
}
|
|
|
|
sub clear {
|
|
my $self = shift;
|
|
$self->{hash} = {};
|
|
}
|
|
|
|
sub levenshtein_matches {
|
|
my ($self, $keyword) = @_;
|
|
my $comma = '';
|
|
my $result = "";
|
|
|
|
foreach my $index (sort keys %{$self->{hash}}) {
|
|
my $distance = fastdistance($keyword, $index);
|
|
my $length = (length $keyword > length $index) ? length $keyword : length $index;
|
|
|
|
if ($length != 0 && $distance / $length < 0.50) {
|
|
$result .= $comma . $index;
|
|
$comma = ", ";
|
|
}
|
|
}
|
|
|
|
$result =~ s/(.*), /$1 or /;
|
|
$result = "none" if $comma eq '';
|
|
return $result;
|
|
}
|
|
|
|
sub set {
|
|
my ($self, $index, $key, $value, $dont_save) = @_;
|
|
my $lc_index = lc $index;
|
|
|
|
if (not exists $self->{hash}->{$lc_index}) {
|
|
my $result = "$self->{name}: $index not found; similiar matches: ";
|
|
$result .= $self->levenshtein_matches($index);
|
|
return $result;
|
|
}
|
|
|
|
if (not defined $key) {
|
|
my $result = "[$self->{name}] " . $self->get_key_name($lc_index) . " keys: ";
|
|
my $comma = '';
|
|
foreach my $k (sort grep { $_ ne '_name' } keys %{$self->{hash}->{$lc_index}}) {
|
|
$result .= $comma . "$k: " . $self->{hash}->{$lc_index}->{$k};
|
|
$comma = ";\n";
|
|
}
|
|
$result .= "none" if ($comma eq '');
|
|
return $result;
|
|
}
|
|
|
|
if (not defined $value) {
|
|
$value = $self->{hash}->{$lc_index}->{$key};
|
|
} else {
|
|
$self->{hash}->{$lc_index}->{$key} = $value;
|
|
$self->save unless $dont_save;
|
|
}
|
|
return "[$self->{name}] " . $self->get_key_name($lc_index) . ": $key " . (defined $value ? "set to $value" : "is not set.");
|
|
}
|
|
|
|
sub unset {
|
|
my ($self, $index, $key) = @_;
|
|
my $lc_index = lc $index;
|
|
|
|
if (not exists $self->{hash}->{$lc_index}) {
|
|
my $result = "$self->{name}: $index not found; similiar matches: ";
|
|
$result .= $self->levenshtein_matches($index);
|
|
return $result;
|
|
}
|
|
|
|
if (defined delete $self->{hash}->{$lc_index}->{$key}) {
|
|
$self->save;
|
|
return "[$self->{name}] " . $self->get_key_name($lc_index) . ": $key unset.";
|
|
} else {
|
|
return "[$self->{name}] " . $self->get_key_name($lc_index) . ": $key does not exist.";
|
|
}
|
|
}
|
|
|
|
sub exists {
|
|
my ($self, $index, $data_index) = @_;
|
|
return exists $self->{hash}->{lc $index} if not defined $data_index;
|
|
return exists $self->{hash}->{lc $index}->{$data_index};
|
|
}
|
|
|
|
sub get_key_name {
|
|
my ($self, $index) = @_;
|
|
my $lc_index = lc $index;
|
|
return $lc_index if not exists $self->{hash}->{$lc_index};
|
|
return exists $self->{hash}->{$lc_index}->{_name} ? $self->{hash}->{$lc_index}->{_name} : $lc_index;
|
|
}
|
|
|
|
sub get_keys {
|
|
my ($self, $index) = @_;
|
|
return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $index;
|
|
return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $index}};
|
|
}
|
|
|
|
sub get_data {
|
|
my ($self, $index, $data_index) = @_;
|
|
my $lc_index = lc $index;
|
|
return undef if not exists $self->{hash}->{$lc_index};
|
|
return $self->{hash}->{$lc_index} if not defined $data_index;
|
|
return $self->{hash}->{$lc_index}->{$data_index};
|
|
}
|
|
|
|
sub add {
|
|
my ($self, $index, $data, $dont_save) = @_;
|
|
my $lc_index = lc $index;
|
|
|
|
# preserve case of index
|
|
if ($index ne $lc_index) {
|
|
$data->{_name} = $index;
|
|
}
|
|
|
|
$self->{hash}->{$lc_index} = $data;
|
|
$self->save unless $dont_save;
|
|
return "$index added to $self->{name}.";
|
|
}
|
|
|
|
sub remove {
|
|
my ($self, $index, $data_index, $dont_save) = @_;
|
|
my $lc_index = lc $index;
|
|
|
|
if (not exists $self->{hash}->{$lc_index}) {
|
|
my $result = "$self->{name}: $index not found; similiar matches: ";
|
|
$result .= $self->levenshtein_matches($lc_index);
|
|
return $result;
|
|
}
|
|
|
|
if (defined $data_index) {
|
|
if (defined delete $self->{hash}->{$lc_index}->{$data_index}) {
|
|
delete $self->{hash}->{$lc_index} if keys(%{$self->{hash}->{$lc_index}}) == 1;
|
|
$self->save unless $dont_save;
|
|
return $self->get_key_name($lc_index) . ".$data_index removed from $self->{name}";
|
|
} else {
|
|
return "$self->{name}: " . $self->get_key_name($lc_index) . ".$data_index does not exist.";
|
|
}
|
|
}
|
|
|
|
my $data = delete $self->{hash}->{$lc_index};
|
|
if (defined $data) {
|
|
$self->save unless $dont_save;
|
|
my $name = exists $data->{_name} ? $data->{_name} : $lc_index;
|
|
return "$name removed from $self->{name}.";
|
|
} else {
|
|
return "$self->{name}: $data_index does not exist.";
|
|
}
|
|
}
|
|
|
|
1;
|