# 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 lib3512::HashObject; use warnings; use strict; use feature 'unicode_strings'; 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 $/; ; }; $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 => 3512 }); } 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 = "; "; } $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;