mirror of
https://github.com/pragma-/pbot.git
synced 2025-01-10 20:12:35 +01:00
Add misc/greybot import utility
This commit is contained in:
Pragmatic Software
parent
2318ad2ec5
commit
6315de18fd
825
misc/greybot/PBot/DualIndexSQLiteObject.pm
Normal file
825
misc/greybot/PBot/DualIndexSQLiteObject.pm
Normal file
@ -0,0 +1,825 @@
|
||||
# File: DualIndexSQLiteObject.pm
|
||||
# Author: pragma_
|
||||
#
|
||||
# Purpose: Provides a dual-indexed SQLite object with an abstracted API that includes
|
||||
# setting and deleting values, caching, displaying nearest matches, etc. Designed to
|
||||
# be as compatible as possible with DualIndexHashObject; e.g. get_keys, get_data, etc.
|
||||
|
||||
# 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::DualIndexSQLiteObject;
|
||||
|
||||
use warnings; use strict;
|
||||
use feature 'unicode_strings';
|
||||
|
||||
use DBI;
|
||||
use Text::Levenshtein qw(fastdistance);
|
||||
|
||||
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->{name} = $conf{name} // 'Dual Index SQLite object';
|
||||
$self->{filename} = $conf{filename} // Carp::croak("Missing filename in " . __FILE__);
|
||||
|
||||
$self->{dbh} = undef;
|
||||
$self->{cache} = {};
|
||||
$self->{cache_timeouts} = {};
|
||||
|
||||
$self->{debug} = $conf{debug} // '';
|
||||
|
||||
$self->begin;
|
||||
}
|
||||
|
||||
sub begin {
|
||||
my ($self) = @_;
|
||||
|
||||
print("Opening $self->{name} database ($self->{filename})\n");
|
||||
|
||||
$self->{dbh} = DBI->connect(
|
||||
"dbi:SQLite:dbname=$self->{filename}", "", "",
|
||||
{RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1, sqlite_unicode => 1}
|
||||
) or die $DBI::errstr;
|
||||
|
||||
if ($@) { print("Error initializing $self->{name} database: $@\n"); }
|
||||
}
|
||||
|
||||
sub end {
|
||||
my ($self) = @_;
|
||||
|
||||
print("Closing $self->{name} database ($self->{filename})\n");
|
||||
|
||||
if (defined $self->{dbh}) {
|
||||
$self->{dbh}->commit;
|
||||
$self->{dbh}->disconnect;
|
||||
$self->{dbh} = undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub load {
|
||||
my ($self) = @_;
|
||||
$self->create_database;
|
||||
$self->create_cache;
|
||||
}
|
||||
|
||||
sub create_database {
|
||||
my ($self) = @_;
|
||||
|
||||
eval {
|
||||
$self->{dbh}->do(<<SQL);
|
||||
CREATE TABLE IF NOT EXISTS Stuff (
|
||||
index1 TEXT COLLATE NOCASE,
|
||||
index2 TEXT COLLATE NOCASE
|
||||
)
|
||||
SQL
|
||||
|
||||
$self->{dbh}->do('CREATE INDEX IF NOT EXISTS idx1 ON Stuff (index1, index2)');
|
||||
};
|
||||
|
||||
print($@) if $@;
|
||||
}
|
||||
|
||||
sub create_cache {
|
||||
my ($self) = @_;
|
||||
$self->{cache} = {};
|
||||
|
||||
my ($index1_count, $index2_count) = (0, 0);
|
||||
foreach my $index1 ($self->get_keys(undef, undef, 1)) {
|
||||
$index1_count++;
|
||||
my $lc_index1 = lc $index1;
|
||||
foreach my $index2 ($self->get_keys($lc_index1, undef, 1)) {
|
||||
my $lc_index2 = lc $index2;
|
||||
$index2_count++;
|
||||
$self->{cache}->{$lc_index1}->{lc $index2} = {};
|
||||
$self->{cache}->{$lc_index1}->{_name} = $index1 if $index1 ne $lc_index1;
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{_name} = $index2 if $index2 ne $lc_index2;
|
||||
}
|
||||
}
|
||||
|
||||
print("Cached $index2_count $self->{name} objects in $index1_count groups.\n");
|
||||
}
|
||||
|
||||
sub cache_remove {
|
||||
my ($self, $index1, $index2) = @_;
|
||||
|
||||
if (not defined $index2) {
|
||||
delete $self->{cache}->{$index1};
|
||||
delete $self->{cache_timeouts}->{$index1};
|
||||
} else {
|
||||
delete $self->{cache}->{$index1}->{$index2};
|
||||
delete $self->{cache}->{$index1} if not grep { $_ ne '_name' } keys %{$self->{cache}->{$index1}};
|
||||
delete $self->{cache_timeouts}->{$index1}->{$index2};
|
||||
delete $self->{cache_timeouts}->{$index1} if not keys %{$self->{cache_timeouts}->{$index1}};
|
||||
}
|
||||
}
|
||||
|
||||
sub trim_cache {
|
||||
my ($self) = @_;
|
||||
|
||||
my $now = time;
|
||||
foreach my $index1 (keys %{$self->{cache_timeouts}}) {
|
||||
foreach my $index2 (keys %{$self->{cache_timeouts}->{$index1}}) {
|
||||
if ($now >= $self->{cache_timeouts}->{$index1}->{$index2}) {
|
||||
my $name = $self->{cache}->{$index1}->{$index2}->{_name};
|
||||
$self->{cache}->{$index1}->{$index2} = {};
|
||||
$self->{cache}->{$index1}->{$index2}->{_name} = $name if defined $name;
|
||||
delete $self->{cache_timeouts}->{$index1}->{$index2};
|
||||
delete $self->{cache_timeouts}->{$index1} if not keys %{$self->{cache_timeouts}->{$index1}};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub create_metadata {
|
||||
my ($self, $columns) = @_;
|
||||
return if not $self->{dbh};
|
||||
|
||||
$self->{columns} = $columns;
|
||||
|
||||
eval {
|
||||
my %existing = ();
|
||||
foreach my $col (@{$self->{dbh}->selectall_arrayref("PRAGMA TABLE_INFO(Stuff)")}) { $existing{$col->[1]} = $col->[2]; }
|
||||
|
||||
$self->{dbh}->begin_work;
|
||||
|
||||
foreach my $col (sort keys %$columns) {
|
||||
unless (exists $existing{$col}) { $self->{dbh}->do("ALTER TABLE Stuff ADD COLUMN \"$col\" $columns->{$col}"); }
|
||||
}
|
||||
|
||||
$self->{dbh}->commit;
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print($@);
|
||||
$self->{dbh}->rollback;
|
||||
}
|
||||
}
|
||||
|
||||
sub begin_work {
|
||||
my ($self) = @_;
|
||||
$self->{dbh}->begin_work;
|
||||
}
|
||||
|
||||
sub commit {
|
||||
my ($self) = @_;
|
||||
$self->{dbh}->commit;
|
||||
}
|
||||
|
||||
sub levenshtein_matches {
|
||||
my ($self, $index1, $index2, $distance, $strictnamespace) = @_;
|
||||
my $comma = '';
|
||||
my $result = '';
|
||||
|
||||
$distance = 0.60 if not defined $distance;
|
||||
|
||||
$index1 = '.*' if not defined $index1;
|
||||
|
||||
if (not $index2) {
|
||||
foreach my $index (sort $self->get_keys) {
|
||||
my $distance_result = fastdistance($index1, $index);
|
||||
my $length = (length $index1 > length $index) ? length $index1 : length $index;
|
||||
|
||||
if ($distance_result / $length < $distance) {
|
||||
my $name = $self->get_data($index, '_name');
|
||||
if ($name =~ / /) { $result .= $comma . "\"$name\""; }
|
||||
else { $result .= $comma . $name; }
|
||||
$comma = ", ";
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (not $self->exists($index1)) { return 'none'; }
|
||||
|
||||
my $last_header = '';
|
||||
my $header = '';
|
||||
|
||||
foreach my $i1 (sort $self->get_keys) {
|
||||
$header = '[' . $self->get_data($i1, '_name') . '] ';
|
||||
$header = '[global] ' if $header eq '[.*] ';
|
||||
|
||||
if ($strictnamespace) {
|
||||
next unless $i1 eq '.*' or lc $i1 eq lc $index1;
|
||||
$header = "" unless $header eq '[global] ';
|
||||
}
|
||||
|
||||
foreach my $i2 (sort $self->get_keys($i1)) {
|
||||
my $distance_result = fastdistance($index2, $i2);
|
||||
my $length = (length $index2 > length $i2) ? length $index2 : length $i2;
|
||||
|
||||
if ($distance_result / $length < $distance) {
|
||||
my $name = $self->get_data($i1, $i2, '_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 exists {
|
||||
my ($self, $index1, $index2, $data_index) = @_;
|
||||
return 0 if not defined $index1;
|
||||
$index1 = lc $index1;
|
||||
return 0 if not grep { $_ eq $index1 } $self->get_keys;
|
||||
return 1 if not defined $index2;
|
||||
$index2 = lc $index2;
|
||||
return 0 if not grep { $_ eq $index2 } $self->get_keys($index1);
|
||||
return 1 if not defined $data_index;
|
||||
return defined $self->get_data($index1, $index2, $data_index);
|
||||
}
|
||||
|
||||
sub get_keys {
|
||||
my ($self, $index1, $index2, $nocache) = @_;
|
||||
my @keys;
|
||||
|
||||
if (not defined $index1) {
|
||||
if (not $nocache) { return keys %{$self->{cache}}; }
|
||||
|
||||
@keys = eval {
|
||||
my $context = $self->{dbh}->selectall_arrayref('SELECT DISTINCT index1 FROM Stuff');
|
||||
if (@$context) {
|
||||
return map { $_->[0] } @$context;
|
||||
} else {
|
||||
return ();
|
||||
}
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print($@);
|
||||
return undef;
|
||||
}
|
||||
|
||||
return @keys;
|
||||
}
|
||||
|
||||
$index1 = lc $index1;
|
||||
|
||||
if (not defined $index2) {
|
||||
if (not $nocache) { return grep { $_ ne '_name' } keys %{$self->{cache}->{$index1}}; }
|
||||
|
||||
@keys = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT index2 FROM Stuff WHERE index1 = ?');
|
||||
$sth->execute($index1);
|
||||
my $context = $sth->fetchall_arrayref;
|
||||
if (@$context) {
|
||||
return map { $_->[0] } @$context;
|
||||
} else {
|
||||
return ();
|
||||
}
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print($@);
|
||||
return ();
|
||||
}
|
||||
|
||||
return @keys;
|
||||
}
|
||||
|
||||
$index2 = lc $index2;
|
||||
|
||||
if (not $nocache) {
|
||||
@keys = grep { $_ ne '_name' } keys %{$self->{cache}->{$index1}->{$index2}};
|
||||
return @keys if @keys;
|
||||
}
|
||||
|
||||
@keys = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT * FROM Stuff WHERE index1 = ? AND index2 = ?');
|
||||
$sth->execute($index1, $index2);
|
||||
my $context = $sth->fetchall_arrayref({});
|
||||
my @k = ();
|
||||
return @k if not @{$context};
|
||||
|
||||
my ($lc_index1, $lc_index2) = (lc $index1, lc $index2);
|
||||
foreach my $key (keys %{$context->[0]}) {
|
||||
next if $key eq 'index1' or $key eq 'index2';
|
||||
push @k, $key if defined $context->[0]->{$key};
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{$key} = $context->[0]->{$key};
|
||||
}
|
||||
|
||||
my $timeout = 60 * 30;
|
||||
$self->{cache_timeouts}->{$lc_index1}->{$lc_index2} = time + $timeout;
|
||||
|
||||
return @k;
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print($@);
|
||||
return ();
|
||||
}
|
||||
|
||||
return @keys;
|
||||
}
|
||||
|
||||
sub get_each {
|
||||
my ($self, @opts) = @_;
|
||||
|
||||
my $sth = eval {
|
||||
my $sql = 'SELECT ';
|
||||
my @keys = ();
|
||||
my @values = ();
|
||||
my @where = ();
|
||||
my @sort = ();
|
||||
my $everything = 0;
|
||||
|
||||
foreach my $expr (@opts) {
|
||||
my ($key, $op, $value) = split /\s*([!=<>]+)\s*/, $expr, 3;
|
||||
|
||||
if ($key eq '_everything') {
|
||||
$everything = 1;
|
||||
push @keys, '*';
|
||||
next;
|
||||
}
|
||||
|
||||
if ($key eq '_sort') {
|
||||
if ($value =~ s/^\-//) {
|
||||
push @sort, "$value DESC";
|
||||
} else {
|
||||
$value =~ s/^\+//; # optional
|
||||
push @sort, "$value ASC";
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined $op) {
|
||||
my $prefix = 'AND';
|
||||
|
||||
if ($op eq '=' or $op eq '==') {
|
||||
$op = '=';
|
||||
} elsif ($op eq '!=' or $op eq '<>') {
|
||||
$op = '!=';
|
||||
}
|
||||
|
||||
if ($key =~ s/^(OR|AND)\s+//) {
|
||||
$prefix = $1;
|
||||
}
|
||||
|
||||
$prefix = '' if not @where;
|
||||
push @where, [ $prefix, $key, $op ];
|
||||
push @values, $value;
|
||||
}
|
||||
|
||||
push @keys, $key unless $everything or grep { $_ eq $key } @keys;
|
||||
}
|
||||
|
||||
$sql .= join ', ', @keys;
|
||||
$sql .= ' FROM Stuff WHERE';
|
||||
|
||||
my $in_or = 0;
|
||||
for (my $i = 0; $i < @where; $i++) {
|
||||
my ($prefix, $key, $op) = @{$where[$i]};
|
||||
my ($next_prefix, $next_key) = ('', '');
|
||||
|
||||
if ($i < @where - 1) {
|
||||
($next_prefix, $next_key) = @{$where[$i + 1]};
|
||||
}
|
||||
|
||||
if ($next_prefix eq 'OR' and $next_key eq $key) {
|
||||
$sql .= "$prefix ";
|
||||
$sql .= '(' if not $in_or;
|
||||
$sql .= "\"$key\" $op ? ";
|
||||
$in_or = 1;
|
||||
} else {
|
||||
$sql .= "$prefix \"$key\" $op ? ";
|
||||
|
||||
if ($in_or) {
|
||||
$sql .= ') ';
|
||||
$in_or = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$sql .= ')' if $in_or;
|
||||
|
||||
$sql .= ' ORDER BY ' . join(', ', @sort) if @sort;
|
||||
|
||||
my $sth = $self->{dbh}->prepare($sql);
|
||||
|
||||
my $param = 0;
|
||||
foreach my $value (@values) {
|
||||
$sth->bind_param(++$param, $value);
|
||||
}
|
||||
|
||||
$sth->execute;
|
||||
return $sth;
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error getting data: $@\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $sth;
|
||||
}
|
||||
|
||||
sub get_next {
|
||||
my ($self, $sth) = @_;
|
||||
|
||||
my $data = eval {
|
||||
return $sth->fetchrow_hashref;
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error getting next: $@\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $data;
|
||||
}
|
||||
|
||||
sub get_all {
|
||||
my ($self, @opts) = @_;
|
||||
|
||||
my $sth = $self->get_each(@opts);
|
||||
|
||||
my $data = eval {
|
||||
return $sth->fetchall_arrayref({});
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error getting data: $@\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
return @$data;
|
||||
}
|
||||
|
||||
sub get_key_name {
|
||||
my ($self, $index1, $index2) = @_;
|
||||
|
||||
my $lc_index1 = lc $index1;
|
||||
|
||||
return $lc_index1 if not exists $self->{cache}->{$lc_index1};
|
||||
|
||||
if (not defined $index2) {
|
||||
if (exists $self->{cache}->{$lc_index1}->{_name}) {
|
||||
return $self->{cache}->{$lc_index1}->{_name};
|
||||
} else {
|
||||
return $lc_index1;
|
||||
}
|
||||
}
|
||||
|
||||
my $lc_index2 = lc $index2;
|
||||
|
||||
return $lc_index2 if not exists $self->{cache}->{$lc_index1}->{$lc_index2};
|
||||
|
||||
if (exists $self->{cache}->{$lc_index1}->{$lc_index2}->{_name}) {
|
||||
return $self->{cache}->{$lc_index1}->{$lc_index2}->{_name};
|
||||
} else {
|
||||
return $lc_index2;
|
||||
}
|
||||
}
|
||||
|
||||
sub get_data {
|
||||
my ($self, $index1, $index2, $data_index) = @_;
|
||||
|
||||
my $lc_index1 = lc $index1;
|
||||
my $lc_index2 = lc $index2;
|
||||
|
||||
return undef if not exists $self->{cache}->{$lc_index1};
|
||||
return undef if not exists $self->{cache}->{$lc_index1}->{$lc_index2} and $lc_index2 ne '_name';
|
||||
|
||||
if (not defined $data_index) {
|
||||
# special case for compatibility with DualIndexHashObject
|
||||
if ($lc_index2 eq '_name') {
|
||||
if (exists $self->{cache}->{$lc_index1}->{_name}) {
|
||||
return $self->{cache}->{$lc_index1}->{_name};
|
||||
} else {
|
||||
return $lc_index1;
|
||||
}
|
||||
}
|
||||
|
||||
my $data = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT * FROM Stuff WHERE index1 = ? AND index2 = ?');
|
||||
$sth->execute($index1, $index2);
|
||||
my $context = $sth->fetchall_arrayref({});
|
||||
|
||||
my $d = {};
|
||||
foreach my $key (keys %{$context->[0]}) {
|
||||
next if $key eq 'index1' or $key eq 'index2';
|
||||
if (defined $context->[0]->{$key}) {
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{$key} = $context->[0]->{$key};
|
||||
$d->{$key} = $context->[0]->{$key};
|
||||
}
|
||||
}
|
||||
|
||||
my $timeout = 60 * 30;
|
||||
$self->{cache_timeouts}->{$lc_index1}->{$lc_index2} = time + $timeout;
|
||||
|
||||
return $d;
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error getting data for ($index1, $index2): $@\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $data;
|
||||
}
|
||||
|
||||
# special case for compatibility with DualIndexHashObject
|
||||
if ($data_index eq '_name') {
|
||||
if (exists $self->{cache}->{$lc_index1}->{$lc_index2}->{_name}) {
|
||||
return $self->{cache}->{$lc_index1}->{$lc_index2}->{_name};
|
||||
} else {
|
||||
return $lc_index2;
|
||||
}
|
||||
}
|
||||
|
||||
if (exists $self->{cache}->{$lc_index1}->{$lc_index2}->{$data_index}) {
|
||||
return $self->{cache}->{$lc_index1}->{$lc_index2}->{$data_index};
|
||||
}
|
||||
|
||||
my $value = eval {
|
||||
my $sth = $self->{dbh}->prepare('SELECT * FROM Stuff WHERE index1 = ? AND index2 = ?');
|
||||
$sth->execute($index1, $index2);
|
||||
my $context = $sth->fetchall_arrayref({});
|
||||
|
||||
foreach my $key (keys %{$context->[0]}) {
|
||||
next if $key eq 'index1' or $key eq 'index2';
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{$key} = $context->[0]->{$key};
|
||||
}
|
||||
|
||||
my $timeout = 60 * 30;
|
||||
$self->{cache_timeouts}->{$lc_index1}->{$lc_index2} = time + $timeout;
|
||||
|
||||
return $context->[0]->{$data_index};
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error getting data for ($index1, $index2, $data_index): $@\n");
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub add {
|
||||
my ($self, $index1, $index2, $data, $quiet) = @_;
|
||||
|
||||
my $name1 = $self->get_data($index1, '_name') // $index1;
|
||||
|
||||
eval {
|
||||
my $sth;
|
||||
|
||||
if (not $self->exists($index1, $index2)) {
|
||||
$sth = $self->{dbh}->prepare('INSERT INTO Stuff (index1, index2) VALUES (?, ?)');
|
||||
$sth->execute($name1, $index2);
|
||||
}
|
||||
|
||||
my $sql = 'UPDATE Stuff SET ';
|
||||
|
||||
my $comma = '';
|
||||
foreach my $key (sort keys %$data) {
|
||||
if (not exists $self->{columns}->{$key}) {
|
||||
next;
|
||||
}
|
||||
$sql .= "$comma\"$key\" = ?";
|
||||
$comma = ', ';
|
||||
}
|
||||
|
||||
$sql .= ' WHERE index1 == ? AND index2 == ?';
|
||||
|
||||
$sth = $self->{dbh}->prepare($sql);
|
||||
|
||||
my $param = 1;
|
||||
foreach my $key (sort keys %$data) {
|
||||
next if not exists $self->{columns}->{$key};
|
||||
$sth->bind_param($param++, $data->{$key});
|
||||
}
|
||||
|
||||
$sth->bind_param($param++, $index1);
|
||||
$sth->bind_param($param++, $index2);
|
||||
$sth->execute();
|
||||
|
||||
# no errors updating SQL -- now we update cache
|
||||
my ($lc_index1, $lc_index2) = (lc $index1, lc $index2);
|
||||
$self->{cache}->{$lc_index1}->{_name} = $index1 if $index1 ne $lc_index1 and not exists $self->{cache}->{$lc_index1}->{_name};
|
||||
if (grep { $_ ne '_name' } keys %{$self->{cache}->{$lc_index1}->{$lc_index2}}) {
|
||||
foreach my $key (sort keys %$data) {
|
||||
next if not exists $self->{columns}->{$key};
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{$key} = $data->{$key};
|
||||
}
|
||||
} else {
|
||||
$self->{cache}->{$lc_index1}->{lc $index2} = {}
|
||||
}
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{_name} = $index2 if not exists $self->{cache}->{$lc_index1}->{$lc_index2}->{_name} and $index2 ne $lc_index2;
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error adding $self->{name} $index2 to $index1: $@\n");
|
||||
$self->{dbh}->rollback;
|
||||
return "Error adding $index2 to $name1: $@\n";
|
||||
}
|
||||
|
||||
$index1 = 'global' if $index1 eq '.*';
|
||||
$index2 = "\"$index2\"" if $index2 =~ / /;
|
||||
print("$self->{name}: [$index1]: $index2 added.\n") unless $quiet;
|
||||
return "$index2 added to $name1.";
|
||||
}
|
||||
|
||||
sub remove {
|
||||
my ($self, $index1, $index2, $data_index, $dont_save) = @_;
|
||||
|
||||
if (not $self->exists($index1)) {
|
||||
my $result = "$self->{name}: $index1 not found; similiar matches: ";
|
||||
$result .= $self->levenshtein_matches($index1);
|
||||
return $result;
|
||||
}
|
||||
|
||||
my $name1 = $self->get_data($index1, '_name');
|
||||
$name1 = 'global' if $name1 eq '.*';
|
||||
my $lc_index1 = lc $index1;
|
||||
|
||||
if (not defined $index2) {
|
||||
eval {
|
||||
my $sth = $self->{dbh}->prepare("DELETE FROM Stuff WHERE index1 = ?");
|
||||
$sth->execute($index1);
|
||||
|
||||
$self->cache_remove($index1);
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error removing $index1 from $self->{name}: $@\n");
|
||||
return "Error removing $name1: $@";
|
||||
}
|
||||
|
||||
return "$name1 removed.";
|
||||
}
|
||||
|
||||
if (not $self->exists($index1, $index2)) {
|
||||
my $result = "$self->{name}: [$name1] $index2 not found; similiar matches: ";
|
||||
$result .= $self->levenshtein_matches($index1, $index2);
|
||||
return $result;
|
||||
}
|
||||
|
||||
my $name2 = $self->get_data($index1, $index2, '_name');
|
||||
$name2 = "\"$name2\"" if $name2 =~ / /;
|
||||
my $lc_index2 = lc $index2;
|
||||
|
||||
if (not defined $data_index) {
|
||||
eval {
|
||||
my $sth = $self->{dbh}->prepare("DELETE FROM Stuff WHERE index1 = ? AND index2 = ?");
|
||||
$sth->execute($index1, $index2);
|
||||
|
||||
$self->cache_remove($index1, $index2);
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error removing $self->{name}: [$name1] $name2: $@\n");
|
||||
return "Error removing $name2 from $name1: $@";
|
||||
}
|
||||
|
||||
return "$name2 removed from $name1.";
|
||||
}
|
||||
|
||||
if (not exists $self->{columns}->{$data_index}) {
|
||||
return "$self->{name} have no such metadata $data_index.";
|
||||
}
|
||||
|
||||
if (defined $self->get_data($lc_index1, $lc_index2, $data_index)) {
|
||||
eval {
|
||||
my $sth = $self->{dbh}->prepare("UPDATE Stuff SET '$data_index' = ? WHERE index1 = ? AND index2 = ?");
|
||||
$sth->execute(undef, $index1, $index2);
|
||||
|
||||
$self->{cache}->{$index1}->{$index2}->{$data_index} = undef;
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error unsetting $self->{name}: $name1.$name2: $@\n");
|
||||
return "Error unsetting $data_index from $name2: $@";
|
||||
}
|
||||
|
||||
return "$name2.$data_index unset.";
|
||||
}
|
||||
|
||||
return "$name2.$data_index is not set.";
|
||||
}
|
||||
|
||||
sub set {
|
||||
my ($self, $index1, $index2, $key, $value) = @_;
|
||||
|
||||
if (not $self->exists($index1)) {
|
||||
my $result = "$self->{name}: $index1 not found; similiar matches: ";
|
||||
$result .= $self->levenshtein_matches($index1);
|
||||
return $result;
|
||||
}
|
||||
|
||||
if (not $self->exists($index1, $index2)) {
|
||||
my $secondary_text = $index2 =~ / / ? "\"$index2\"" : $index2;
|
||||
my $result = "$self->{name}: [" . $self->get_data($index1, '_name') . "] $secondary_text not found; similiar matches: ";
|
||||
$result .= $self->levenshtein_matches($index1, $index2);
|
||||
return $result;
|
||||
}
|
||||
|
||||
my $name1 = $self->get_data($index1, '_name');
|
||||
my $name2 = $self->get_data($index1, $index2, '_name');
|
||||
|
||||
$name1 = 'global' if $name1 eq '.*';
|
||||
$name2 = "\"$name2\"" if $name2 =~ / /;
|
||||
|
||||
if (not defined $key) {
|
||||
my $result = "[$name1] $name2 keys:\n";
|
||||
my @metadata = ();
|
||||
foreach my $key (sort $self->get_keys($index1, $index2)) {
|
||||
my $value = $self->get_data($index1, $index2, $key);
|
||||
push @metadata, "$key => $value" if defined $value;
|
||||
}
|
||||
if (not @metadata) { $result .= "none"; }
|
||||
else { $result .= join ";\n", @metadata; }
|
||||
return $result;
|
||||
}
|
||||
|
||||
if (not exists $self->{columns}->{$key}) {
|
||||
return "$self->{name} have no such metadata $key.";
|
||||
}
|
||||
|
||||
if (not defined $value) { $value = $self->get_data($index1, $index2, $key); }
|
||||
else {
|
||||
eval {
|
||||
my $sth = $self->{dbh}->prepare("UPDATE Stuff SET '$key' = ? WHERE index1 = ? AND index2 = ?");
|
||||
$sth->execute($value, $index1, $index2);
|
||||
|
||||
my ($lc_index1, $lc_index2) = (lc $index1, lc $index2);
|
||||
if (exists $self->{cache}->{$lc_index1}
|
||||
and exists $self->{cache}->{$lc_index1}->{$lc_index2}
|
||||
and exists $self->{cache}->{$lc_index1}->{$lc_index2}->{$key}) {
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{$key} = $value;
|
||||
}
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error setting $self->{name} $index1 $index2.$key: $@\n");
|
||||
return "Error setting $name2.$key: $@";
|
||||
}
|
||||
}
|
||||
|
||||
return "[$name1] $name2.$key " . (defined $value ? "set to $value" : "is not set.");
|
||||
}
|
||||
|
||||
sub unset {
|
||||
my ($self, $index1, $index2, $key) = @_;
|
||||
|
||||
if (not $self->exists($index1)) {
|
||||
my $result = "$self->{name}: $index1 not found; similiar matches: ";
|
||||
$result .= $self->levenshtein_matches($index1);
|
||||
return $result;
|
||||
}
|
||||
|
||||
my $name1 = $self->get_data($index1, '_name');
|
||||
$name1 = 'global' if $name1 eq '.*';
|
||||
|
||||
if (not $self->exists($index1, $index2)) {
|
||||
my $result = "$self->{name}: [$name1] $index2 not found; similiar matches: ";
|
||||
$result .= $self->levenshtein_matches($index1, $index2);
|
||||
return $result;
|
||||
}
|
||||
|
||||
my $name2 = $self->get_data($index1, $index2, '_name');
|
||||
$name2 = "\"$name2\"" if $name2 =~ / /;
|
||||
|
||||
if (not exists $self->{columns}->{$key}) {
|
||||
return "$self->{name} have no such metadata $key.";
|
||||
}
|
||||
|
||||
eval {
|
||||
my $sth = $self->{dbh}->prepare("UPDATE Stuff SET '$key' = ? WHERE index1 = ? AND index2 = ?");
|
||||
$sth->execute(undef, $index1, $index2);
|
||||
|
||||
my ($lc_index1, $lc_index2) = (lc $index1, lc $index2);
|
||||
if (exists $self->{cache}->{$lc_index1}
|
||||
and exists $self->{cache}->{$lc_index1}->{$lc_index2}
|
||||
and exists $self->{cache}->{$lc_index1}->{$lc_index2}->{$key}) {
|
||||
$self->{cache}->{$lc_index1}->{$lc_index2}->{$key} = undef;
|
||||
}
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print("Error unsetting key: $@\n");
|
||||
return "Error unsetting key: $@";
|
||||
}
|
||||
|
||||
return "[$name1] $name2.$key unset.";
|
||||
}
|
||||
|
||||
# nothing to do here for SQLite
|
||||
# kept for compatibility with DualIndexHashObject
|
||||
sub save { }
|
||||
sub clear { }
|
||||
|
||||
1;
|
||||
111
misc/greybot/import-greybot.pl
Executable file
111
misc/greybot/import-greybot.pl
Executable file
@ -0,0 +1,111 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
# quick-and-dirty script to import greybot factoids
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use lib '.';
|
||||
|
||||
use File::Basename;
|
||||
use PBot::DualIndexSQLiteObject;
|
||||
|
||||
my @skip = qw/bash ksh check/;
|
||||
|
||||
# PBot/Factoids.pm
|
||||
my %factoid_metadata = (
|
||||
'action' => 'TEXT',
|
||||
'action_with_args' => 'TEXT',
|
||||
'add_nick' => 'INTEGER',
|
||||
'allow_empty_args' => 'INTEGER',
|
||||
'background-process' => 'INTEGER',
|
||||
'cap-override' => 'TEXT',
|
||||
'created_on' => 'NUMERIC',
|
||||
'dont-protect-self' => 'INTEGER',
|
||||
'dont-replace-pronouns' => 'INTEGER',
|
||||
'edited_by' => 'TEXT',
|
||||
'edited_on' => 'NUMERIC',
|
||||
'enabled' => 'INTEGER',
|
||||
'help' => 'TEXT',
|
||||
'interpolate' => 'INTEGER',
|
||||
'keyword_override' => 'TEXT',
|
||||
'last_referenced_in' => 'TEXT',
|
||||
'last_referenced_on' => 'NUMERIC',
|
||||
'locked' => 'INTEGER',
|
||||
'locked_to_channel' => 'INTEGER',
|
||||
'no_keyword_override' => 'INTEGER',
|
||||
'noembed' => 'INTEGER',
|
||||
'nooverride' => 'INTEGER',
|
||||
'owner' => 'TEXT',
|
||||
'persist-key' => 'INTEGER',
|
||||
'preserve_whitespace' => 'INTEGER',
|
||||
'process-timeout' => 'INTEGER',
|
||||
'rate_limit' => 'INTEGER',
|
||||
'ref_count' => 'INTEGER',
|
||||
'ref_user' => 'TEXT',
|
||||
'require_explicit_args' => 'INTEGER',
|
||||
'requires_arguments' => 'INTEGER',
|
||||
'type' => 'TEXT',
|
||||
'unquote_spaces' => 'INTEGER',
|
||||
'usage' => 'TEXT',
|
||||
'use_output_queue' => 'INTEGER',
|
||||
'workdir' => 'TEXT',
|
||||
);
|
||||
|
||||
my $f = PBot::DualIndexSQLiteObject->new(name => 'Factoids', filename => './greybot.sqlite3');
|
||||
$f->load;
|
||||
$f->create_metadata(\%factoid_metadata);
|
||||
|
||||
$f->begin_work;
|
||||
|
||||
my @files = glob 'meta/*';
|
||||
|
||||
foreach my $file (sort @files) {
|
||||
my $factoid = basename $file;
|
||||
print "Reading $factoid ($file)\n";
|
||||
|
||||
if (grep { $_ eq $factoid } @skip) {
|
||||
print "SKIPPING $file!\n";
|
||||
next;
|
||||
}
|
||||
|
||||
open my $fh, '<', $file or die "Couldn't open $file: $!\n";
|
||||
|
||||
my @lines = <$fh>;
|
||||
my $fact = $lines[$#lines];
|
||||
chomp $fact;
|
||||
print " === Got factoid [$fact]\n";
|
||||
|
||||
my ($nick, $timestamp, $command, $text) = split /\s/, $fact, 4;
|
||||
|
||||
$text = '' if not defined $text;
|
||||
|
||||
print " nick: [$nick], timestamp: [$timestamp], cmd: [$command], text: [$text]\n";
|
||||
|
||||
if (lc $command eq 'forget') {
|
||||
print " --- skipping factoid (deleted)\n";
|
||||
next;
|
||||
}
|
||||
|
||||
if ($text =~ m/^#redirect (.*)/i) {
|
||||
$text = "/call $1";
|
||||
} else {
|
||||
$text = "/say $text";
|
||||
}
|
||||
|
||||
print " +++ Adding factoid: $factoid is $text\n";
|
||||
|
||||
my $data = {
|
||||
enabled => 1,
|
||||
type => 'text',
|
||||
action => $text,
|
||||
owner => $nick,
|
||||
created_on => $timestamp,
|
||||
ref_count => 0,
|
||||
ref_user => "nobody",
|
||||
};
|
||||
|
||||
$f->add('#bash', $factoid, $data);
|
||||
}
|
||||
|
||||
$f->end;
|
||||
Loading…
Reference in New Issue
Block a user