Add version metadata to JSON files

PBot/DualIndexHashObject.pm

@@ -110,6 +110,10 @@ sub save {
 
     $self->{pbot}->{logger}->log("Saving $self->{name} to $filename\n");
 
+    if (not $self->get_data('$metadata$', '$metadata$', 'update_version')) {
+        $self->add('$metadata$', '$metadata$', { update_version => PBot::VERSION::BUILD_REVISION });
+    }
+
     my $json      = JSON->new;
     my $json_text = $json->pretty->canonical->utf8->encode($self->{hash});
 
@@ -273,13 +277,13 @@ sub exists {
 
 sub get_keys {
     my ($self, $primary_index, $secondary_index) = @_;
-    return keys %{$self->{hash}} if not defined $primary_index;
+    return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $primary_index;
 
     my $lc_primary_index = lc $primary_index;
 
     if (not defined $secondary_index) {
         return () if not exists $self->{hash}->{$lc_primary_index};
-        return grep { $_ ne '_name' } keys %{$self->{hash}->{$lc_primary_index}};
+        return grep { $_ ne '_name' and $_ ne '$metadata$' } keys %{$self->{hash}->{$lc_primary_index}};
     }
 
     my $lc_secondary_index = lc $secondary_index;

PBot/HashObject.pm

@@ -92,6 +92,10 @@ sub save {
 
     $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 });
+    }
+
     my $json      = JSON->new;
     my $json_text = $json->pretty->canonical->utf8->encode($self->{hash});
 
@@ -181,7 +185,7 @@ sub exists {
 
 sub get_keys {
     my ($self, $index) = @_;
-    return keys %{$self->{hash}} if not defined $index;
+    return grep { $_ ne '$metadata$' } keys %{$self->{hash}} if not defined $index;
     return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $index}};
 }
 

PBot/Updater.pm

@@ -28,7 +28,7 @@ sub update {
 
     $self->{pbot}->{logger}->log("Checking if update needed...\n");
 
-    my $current_version        = $self->get_current_version;
+    my $current_version     = $self->get_current_version;
     my $last_update_version = $self->get_last_update_version;
 
     $self->{pbot}->{logger}->log("Current version: $current_version; last update version: $last_update_version\n");
@@ -47,9 +47,12 @@ sub update {
 
     foreach my $update (@updates) {
         $self->{pbot}->{logger}->log("Executing update script: $update\n");
-        my $output = `$update $self->{data_dir}`;
+        my $output = `$update "$self->{data_dir}" $current_version $last_update_version`;
         my $exit = $? >> 8;
-        $self->{pbot}->{logger}->log("Script completed. Exit $exit. Output: $output");
+        foreach my $line (split /\n/, $output) {
+            $self->{pbot}->{logger}->log("  $line\n");
+        }
+        $self->{pbot}->{logger}->log("Update script completed " . ($exit ? "unsuccessfully (exit $exit)" : 'successfully') . "\n");
         return $exit if $exit != 0;
     }
 

updates/3503_add_version_info.pl

@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+# Adds version metadata to HashObject and DualIndexHashObject JSON files
+
+use warnings; use strict;
+
+BEGIN {
+    use File::Basename;
+    my $location = -l __FILE__ ? dirname readlink __FILE__ : dirname __FILE__;
+    unshift @INC, $location;
+}
+
+use lib3503::HashObject;
+use lib3503::DualIndexHashObject;
+use lib3503::PBot;
+
+my ($data_dir, $version, $last_update) = @ARGV;
+
+print "Adding version info... version: $version, last_update: $last_update, data_dir: $data_dir\n";
+
+my @hashobjects = qw/channels commands capabilities/;
+my @dualindex = qw/unban_timeout unmute_timeout ban-exemptions ignorelist registry spam_keywords users/;
+
+my $pbot = lib3503::PBot->new();
+
+foreach my $hashobject (@hashobjects) {
+    print "Updating $data_dir/$hashobject ...\n";
+    my $obj = lib3503::HashObject->new(name => $hashobject, filename => "$data_dir/$hashobject", pbot => $pbot);
+    $obj->load;
+
+    my $ver = $obj->get_data('$metadata$', 'update_version');
+
+    if (defined $ver) {
+        print "$hashobject last update version $ver; ";
+        if ($ver >= 3503) {
+            print "no update needed\n";
+            next;
+        } else {
+            print "updating...\n";
+        }
+    }
+
+    print "Adding version info\n";
+    $obj->add('$metadata$', { update_version => 3503 });
+}
+
+foreach my $hashobject (@dualindex) {
+    print "Updating $data_dir/$hashobject ...\n";
+    my $obj = lib3503::DualIndexHashObject->new(name => $hashobject, filename => "$data_dir/$hashobject", pbot => $pbot);
+    $obj->load;
+
+    my $ver = $obj->get_data('$metadata$', '$metadata$', 'update_version');
+
+    if (defined $ver) {
+        print "$hashobject last update version $ver; ";
+        if ($ver >= 3503) {
+            print "no update needed\n";
+            next;
+        } else {
+            print "updating...\n";
+        }
+    }
+
+    print "Adding version info\n";
+    $obj->add('$metadata$', '$metadata$', { update_version => 3503 });
+}
+
+exit 0;

updates/lib3503/DualIndexHashObject.pm

@@ -0,0 +1,385 @@
+# File: DualIndexHashObject.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. This
+# extends the HashObject with an additional index key. Provides case-insensitive
+# access to both index keys, while preserving original case when displaying the
+# keys.
+#
+# Data is stored in working memory for lightning fast performance. If you have
+# a huge amount of data, consider DualIndexSQLiteObject instead.
+
+# 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 lib3503::DualIndexHashObject;
+
+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}     // 'Dual Index hash object';
+    $self->{filename} = $conf{filename} // Carp::carp("Missing filename to DualIndexHashObject, will not be able to save to or load from file.");
+    $self->{hash}     = {};
+}
+
+sub load {
+    my ($self, $filename) = @_;
+    $filename = $self->{filename} if not defined $filename;
+
+    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 if length $contents;
+    close FILE;
+
+    # update existing entries to use _name to preserve case
+    # and lowercase any non-lowercased entries
+    foreach my $primary_index (keys %{$self->{hash}}) {
+        if (not exists $self->{hash}->{$primary_index}->{_name}) {
+            if (lc $primary_index eq $primary_index) { $self->{hash}->{$primary_index}->{_name} = $primary_index; }
+            else {
+                if (exists $self->{hash}->{lc $primary_index}) { Carp::croak "Cannot update $self->{name} primary index $primary_index; duplicate object found"; }
+
+                my $data = delete $self->{hash}->{$primary_index};
+                $data->{_name}                  = $primary_index;
+                $primary_index                  = lc $primary_index;
+                $self->{hash}->{$primary_index} = $data;
+            }
+        }
+
+        foreach my $secondary_index (keys %{$self->{hash}->{$primary_index}}) {
+            next if $secondary_index eq '_name';
+            if (not exists $self->{hash}->{$primary_index}->{$secondary_index}->{_name}) {
+                if (lc $secondary_index eq $secondary_index) { $self->{hash}->{$primary_index}->{$secondary_index}->{_name} = $secondary_index; }
+                else {
+                    if (exists $self->{hash}->{$primary_index}->{lc $secondary_index}) {
+                        Carp::croak "Cannot update $self->{name} $primary_index sub-object $secondary_index; duplicate object found";
+                    }
+
+                    my $data = delete $self->{hash}->{$primary_index}->{$secondary_index};
+                    $data->{_name}                                      = $secondary_index;
+                    $secondary_index                                    = lc $secondary_index;
+                    $self->{hash}->{$primary_index}->{$secondary_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");
+
+    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, $primary_index, $secondary_index, $distance, $strictnamespace) = @_;
+    my $comma  = '';
+    my $result = "";
+
+    $distance = 0.60 if not defined $distance;
+
+    $primary_index = '.*' if not defined $primary_index;
+
+    if (not $secondary_index) {
+        foreach my $index (sort keys %{$self->{hash}}) {
+            my $distance_result = fastdistance($primary_index, $index);
+            my $length          = (length $primary_index > length $index) ? length $primary_index : length $index;
+
+            if ($distance_result / $length < $distance) {
+                my $name = $self->{hash}->{$index}->{_name};
+                if   ($name =~ / /) { $result .= $comma . "\"$name\""; }
+                else                { $result .= $comma . $name; }
+                $comma = ", ";
+            }
+        }
+    } else {
+        my $lc_primary_index = lc $primary_index;
+        if (not exists $self->{hash}->{$lc_primary_index}) { return 'none'; }
+
+        my $last_header = "";
+        my $header      = "";
+
+        foreach my $index1 (sort keys %{$self->{hash}}) {
+            $header = "[$self->{hash}->{$index1}->{_name}] ";
+            $header = '[global] ' if $header eq '[.*] ';
+
+            if ($strictnamespace) {
+                next unless $index1 eq '.*' or $index1 eq $lc_primary_index;
+                $header = "" unless $header eq '[global] ';
+            }
+
+            foreach my $index2 (sort keys %{$self->{hash}->{$index1}}) {
+                my $distance_result = fastdistance($secondary_index, $index2);
+                my $length          = (length $secondary_index > length $index2) ? length $secondary_index : length $index2;
+
+                if ($distance_result / $length < $distance) {
+                    my $name = $self->{hash}->{$index1}->{$index2}->{_name};
+                    $header      = "" if $last_header eq $header;
+                    $last_header = $header;
+                    $comma       = '; ' if $comma ne '' and $header ne '';
+                    if   ($name =~ / /) { $result .= $comma . $header . "\"$name\""; }
+                    else                { $result .= $comma . $header . $name; }
+                    $comma = ", ";
+                }
+            }
+        }
+    }
+
+    $result =~ s/(.*), /$1 or /;
+    $result = 'none' if $comma eq '';
+    return $result;
+}
+
+sub set {
+    my ($self, $primary_index, $secondary_index, $key, $value, $dont_save) = @_;
+    my $lc_primary_index   = lc $primary_index;
+    my $lc_secondary_index = lc $secondary_index;
+
+    if (not exists $self->{hash}->{$lc_primary_index}) {
+        my $result = "$self->{name}: $primary_index not found; similiar matches: ";
+        $result .= $self->levenshtein_matches($primary_index);
+        return $result;
+    }
+
+    if (not exists $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}) {
+        my $secondary_text = $secondary_index =~ / / ? "\"$secondary_index\"" : $secondary_index;
+        my $result         = "$self->{name}: [$self->{hash}->{$lc_primary_index}->{_name}] $secondary_text not found; similiar matches: ";
+        $result .= $self->levenshtein_matches($primary_index, $secondary_index);
+        return $result;
+    }
+
+    my $name1 = $self->{hash}->{$lc_primary_index}->{_name};
+    my $name2 = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{_name};
+
+    $name1 = 'global'     if $name1 eq '.*';
+    $name2 = "\"$name2\"" if $name2 =~ / /;
+
+    if (not defined $key) {
+        my $result = "[$name1] $name2 keys:\n";
+        my $comma  = '';
+        foreach my $key (sort keys %{$self->{hash}->{$lc_primary_index}->{$lc_secondary_index}}) {
+            next if $key eq '_name';
+            $result .= $comma . "$key => " . $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key};
+            $comma = ";\n";
+        }
+        $result .= "none" if ($comma eq '');
+        return $result;
+    }
+
+    if (not defined $value) { $value = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key}; }
+    else {
+        $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key} = $value;
+        $self->save unless $dont_save;
+    }
+
+    return "[$name1] $name2: $key " . (defined $value ? "set to $value" : "is not set.");
+}
+
+sub unset {
+    my ($self, $primary_index, $secondary_index, $key) = @_;
+    my $lc_primary_index   = lc $primary_index;
+    my $lc_secondary_index = lc $secondary_index;
+
+    if (not exists $self->{hash}->{$lc_primary_index}) {
+        my $result = "$self->{name}: $primary_index not found; similiar matches: ";
+        $result .= $self->levenshtein_matches($primary_index);
+        return $result;
+    }
+
+    my $name1 = $self->{hash}->{$lc_primary_index}->{_name};
+    $name1 = 'global' if $name1 eq '.*';
+
+    if (not exists $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}) {
+        my $result = "$self->{name}: [$name1] $secondary_index not found; similiar matches: ";
+        $result .= $self->levenshtein_matches($primary_index, $secondary_index);
+        return $result;
+    }
+
+    my $name2 = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{_name};
+    $name2 = "\"$name2\"" if $name2 =~ / /;
+
+    if (defined delete $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$key}) {
+        $self->save;
+        return "$self->{name}: [$name1] $name2: $key unset.";
+    } else {
+        return "$self->{name}: [$name1] $name2: $key does not exist.";
+    }
+    $self->save;
+}
+
+sub exists {
+    my ($self, $primary_index, $secondary_index, $data_index) = @_;
+    return 0 if not defined $primary_index;
+    $primary_index = lc $primary_index;
+    return 0 if not exists $self->{hash}->{$primary_index};
+    return 1 if not defined $secondary_index;
+    $secondary_index = lc $secondary_index;
+    return 0 if not exists $self->{hash}->{$primary_index}->{$secondary_index};
+    return 1 if not defined $data_index;
+    return exists $self->{hash}->{$primary_index}->{$secondary_index}->{$data_index};
+}
+
+sub get_keys {
+    my ($self, $primary_index, $secondary_index) = @_;
+    return keys %{$self->{hash}} if not defined $primary_index;
+
+    my $lc_primary_index = lc $primary_index;
+
+    if (not defined $secondary_index) {
+        return () if not exists $self->{hash}->{$lc_primary_index};
+        return grep { $_ ne '_name' } keys %{$self->{hash}->{$lc_primary_index}};
+    }
+
+    my $lc_secondary_index = lc $secondary_index;
+
+    return () if not exists $self->{hash}->{$lc_primary_index}
+        or not exists $self->{hash}->{$lc_primary_index}->{$lc_secondary_index};
+
+    return grep { $_ ne '_name' } keys %{$self->{hash}->{lc $primary_index}->{lc $secondary_index}};
+}
+
+sub get_data {
+    my ($self, $primary_index, $secondary_index, $data_index) = @_;
+    $primary_index   = lc $primary_index   if defined $primary_index;
+    $secondary_index = lc $secondary_index if defined $secondary_index;
+    return undef                                               if not exists $self->{hash}->{$primary_index};
+    return $self->{hash}->{$primary_index}                     if not defined $secondary_index;
+    return $self->{hash}->{$primary_index}->{$secondary_index} if not defined $data_index;
+    return $self->{hash}->{$primary_index}->{$secondary_index}->{$data_index};
+}
+
+sub add {
+    my ($self, $primary_index, $secondary_index, $data, $dont_save, $quiet) = @_;
+    my $lc_primary_index   = lc $primary_index;
+    my $lc_secondary_index = lc $secondary_index;
+
+    if (not exists $self->{hash}->{$lc_primary_index}) {
+        $self->{hash}->{$lc_primary_index}->{_name} = $primary_index;    # preserve case
+    }
+
+    $data->{_name} = $secondary_index;                                   # preserve case
+    $self->{hash}->{$lc_primary_index}->{$lc_secondary_index} = $data;
+    $self->save() unless $dont_save;
+
+    my $name1 = $self->{hash}->{$lc_primary_index}->{_name};
+    my $name2 = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{_name};
+    $name1 = 'global'     if $name1 eq '.*';
+    $name2 = "\"$name2\"" if $name2 =~ / /;
+    $self->{pbot}->{logger}->log("$self->{name}: [$name1]: $name2 added.\n") unless $dont_save or $quiet;
+    return "$self->{name}: [$name1]: $name2 added.";
+}
+
+sub remove {
+    my ($self, $primary_index, $secondary_index, $data_index, $dont_save) = @_;
+    my $lc_primary_index   = lc $primary_index;
+    my $lc_secondary_index = lc $secondary_index;
+
+    if (not exists $self->{hash}->{$lc_primary_index}) {
+        my $result = "$self->{name}: $primary_index not found; similiar matches: ";
+        $result .= $self->levenshtein_matches($primary_index);
+        return $result;
+    }
+
+    if (not defined $secondary_index) {
+        my $data = delete $self->{hash}->{$lc_primary_index};
+        if (defined $data) {
+            my $name = $data->{_name};
+            $name = 'global' if $name eq '.*';
+            $self->save unless $dont_save;
+            return "$self->{name}: $name removed.";
+        } else {
+            return "$self->{name}: $primary_index does not exist.";
+        }
+    }
+
+    my $name1 = $self->{hash}->{$lc_primary_index}->{_name};
+    $name1 = 'global' if $name1 eq '.*';
+
+    if (not exists $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}) {
+        my $result = "$self->{name}: [$name1] $secondary_index not found; similiar matches: ";
+        $result .= $self->levenshtein_matches($primary_index, $secondary_index);
+        return $result;
+    }
+
+    if (not defined $data_index) {
+        my $data = delete $self->{hash}->{$lc_primary_index}->{$lc_secondary_index};
+        if (defined $data) {
+            my $name2 = $data->{_name};
+            $name2 = "\"$name2\"" if $name2 =~ / /;
+
+            # remove primary group if no more secondaries (only key left should be the _name key)
+            if (keys %{$self->{hash}->{$lc_primary_index}} == 1) { delete $self->{hash}->{$lc_primary_index}; }
+
+            $self->save unless $dont_save;
+            return "$self->{name}: [$name1] $name2 removed.";
+        } else {
+            return "$self->{name}: [$name1] $secondary_index does not exist.";
+        }
+    }
+
+    my $name2 = $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{_name};
+    if   (defined delete $self->{hash}->{$lc_primary_index}->{$lc_secondary_index}->{$data_index}) { return "$self->{name}: [$name1] $name2.$data_index removed."; }
+    else                                                                                           { return "$self->{name}: [$name1] $name2.$data_index does not exist."; }
+}
+
+# for compatibility with DualIndexSQLiteObject
+sub create_metadata { }
+
+# todo:
+sub get_each { }
+sub get_next { }
+sub get_all  { }
+
+1;

updates/lib3503/HashObject.pm

@@ -0,0 +1,234 @@
+# 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 lib3503::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 $/;
+        <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 (lc $index eq $index) { $self->{hash}->{$index}->{_name} = $index; }
+            else {
+                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");
+
+    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->{hash}->{$lc_index}->{_name} keys: ";
+        my $comma  = '';
+        foreach my $k (sort keys %{$self->{hash}->{$lc_index}}) {
+            next if $k eq '_name';
+            $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->{hash}->{$lc_index}->{_name}: $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->{hash}->{$lc_index}->{_name}: $key unset.";
+    } else {
+        return "[$self->{name}] $self->{hash}->{$lc_index}->{_name}: $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_keys {
+    my ($self, $index) = @_;
+    return 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;
+    $data->{_name} = $index;              # preserve case of 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->{hash}->{$lc_index}->{_name}.$data_index removed from $self->{name}";
+        } else {
+            return "$self->{name}: $self->{hash}->{$lc_index}->{_name}.$data_index does not exist.";
+        }
+    }
+
+    my $data = delete $self->{hash}->{$lc_index};
+    if (defined $data) {
+        $self->save unless $dont_save;
+        return "$data->{_name} removed from $self->{name}.";
+    } else {
+        return "$self->{name}: $data_index does not exist.";
+    }
+}
+
+1;

updates/lib3503/Logger.pm

@@ -0,0 +1,30 @@
+# 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 lib3503::Logger;
+
+use warnings; use strict;
+use feature 'unicode_strings';
+
+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) = @_;
+    return $self;
+}
+
+sub log {
+    my ($self, $text) = @_;
+    print $text;
+}
+
+1;

updates/lib3503/PBot.pm

@@ -0,0 +1,34 @@
+# File: PBot.pm
+# Author: pragma_
+#
+# Purpose: IRC Bot (3rd generation)
+
+# 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 lib3503::PBot;
+
+use strict; use warnings;
+use feature 'unicode_strings';
+
+# unbuffer stdout
+STDOUT->autoflush(1);
+
+use Carp ();
+use lib3503::Logger;
+
+sub new {
+    my ($proto, %conf) = @_;
+    my $class = ref($proto) || $proto;
+    my $self  = bless {}, $class;
+    $self->initialize(%conf);
+    return $self;
+}
+
+sub initialize {
+    my ($self, %conf) = @_;
+    $self->{logger} = lib3503::Logger->new(pbot => $self);
+}
+
+1;