From 729489236f3579d4d10dbb3168d14186763f38c9 Mon Sep 17 00:00:00 2001
From: eleksir <eleksir@exs-elm.ru>
Date: Wed, 7 Apr 2021 13:43:34 +0300
Subject: [PATCH] move admin to CHI

---
 lib/admin.pm | 302 +++++++++++++++------------------------------------
 1 file changed, 88 insertions(+), 214 deletions(-)

diff --git a/lib/admin.pm b/lib/admin.pm
index da8ef12..679f785 100644
--- a/lib/admin.pm
+++ b/lib/admin.pm
@@ -7,8 +7,8 @@ use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Carp qw (cluck croak);
-use File::Path qw (make_path);
-use SQLite_File;
+use CHI;
+use CHI::Driver::BerkeleyDB;
 use conf qw (loadConf);
 use util qw (utf2sha1);
 
@@ -19,25 +19,11 @@ our @ISA    = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitI
 our @EXPORT_OK = qw (@forbiddenMessageTypes @pluginList getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status plugin_toggle plugin_status pluginEnabled);
 
 my $c = loadConf ();
-my $dir = $c->{admin}->{dir};
+my $cachedir = $c->{cachedir};
 # this list is not yet used
 our @pluginList = qw (oboobs obutts); ## no critic (Variables::ProhibitPackageVars)
 our @forbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document); ## no critic (Variables::ProhibitPackageVars)
 
-sub initCensorDB {
-	my $backingfile = shift;
-
-	tie my %censor, 'SQLite_File', $backingfile  ||  cluck "Unable to tie to $backingfile: $OS_ERROR";
-
-	foreach (@forbiddenMessageTypes) {
-		$censor{$_} = 0;
-	}
-
-	untie %censor;
-
-	return;
-}
-
 sub getForbiddenTypes {
 	my $chatid = shift;
 
@@ -49,29 +35,28 @@ sub getForbiddenTypes {
 	}
 
 	my $messageTypes;
-	my $backingfile = utf2sha1 $chatid;
-	$backingfile =~ s/\//-/xmsg;
-	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
-	my %censor;
 
-	unless (-f $backingfile) {
-		initCensorDB ($backingfile);
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
 
-	unless (tie %censor, 'SQLite_File', $backingfile) {
-		cluck "Unable to tie to $backingfile: $OS_ERROR";
-		return $messageTypes;
-	}
+	foreach (@forbiddenMessageTypes) {
+		my $type = $c->get ($_);
 
-	foreach (keys %censor) {
-		if ($censor{$_}) {
+		if ($type) {
 			$messageTypes->{$_} = 1;
 		} else {
-			$messageTypes->{$_} = 0;
+			unless (defined $type) {
+				$c->set ($_, 1, 'never');
+				$messageTypes->{$_} = 1;
+			} else {
+				$messageTypes->{$_} = 0;
+			}
 		}
 	}
 
-	untie %censor;
 	return $messageTypes;
 }
 
@@ -79,31 +64,13 @@ sub addForbiddenType {
 	my $chatid = shift;
 	my $type = shift;
 
-	unless (-d $dir) {
-		unless (make_path $dir) {
-			cluck "Unable to create $dir: $OS_ERROR";
-			return;
-		}
-	}
-
-	my $backingfile = utf2sha1 $chatid;
-	$backingfile =~ s/\//-/xmsg;
-	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
-
-	unless (-f $backingfile) {
-		initCensorDB ($backingfile);
-	}
-
-	my %censor;
-
-	unless (tie %censor, 'SQLite_File', $backingfile) {
-		cluck "Unable to tie to $backingfile: $OS_ERROR";
-		return;
-	}
-
-	$censor{$type} = 1;
-	untie %censor;
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
 
+	$cache->set ($type, 1, 'never');
 	return;
 }
 
@@ -111,72 +78,41 @@ sub delForbiddenType {
 	my $chatid = shift;
 	my $type = shift;
 
-	unless (-d $dir) {
-		unless (make_path $dir) {
-			cluck "Unable to create $dir: $OS_ERROR";
-			return;
-		}
-	}
-
-	my $backingfile = utf2sha1 $chatid;
-	$backingfile =~ s/\//-/xmsg;
-	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
-
-	unless (-f $backingfile) {
-		initCensorDB ($backingfile);
-		return;
-	}
-
-	my %censor;
-
-	unless (tie %censor, 'SQLite_File', $backingfile) {
-		cluck "Unable to tie to $backingfile: $OS_ERROR";
-		return;
-	}
-
-	$censor{$type} = 0;
-	untie %censor;
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
 
+	$cache->remove ($type);
 	return;
 }
 
 sub listForbidden {
 	my $chatid = shift;
-
-	unless (-d $dir) {
-		unless (make_path $dir) {
-			cluck "Unable to create $dir: $OS_ERROR";
-			return;
-		}
-	}
-
 	my @list;
-	my $backingfile = utf2sha1 $chatid;
-	$backingfile =~ s/\//-/xmsg;
-	$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
 
-	unless (-f $backingfile) {
-		initCensorDB ($backingfile);
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
+	);
 
-	my %censor;
+	foreach (@forbiddenMessageTypes) {
+		my $type = $c->get ($_);
 
-	# FIXME: return list with all types alowed
-	unless (tie %censor, 'SQLite_File', $backingfile) {
-		cluck "Unable to tie to $backingfile: $OS_ERROR";
-		return '';
-	}
-
-	foreach (keys %censor) {
-		if ($censor{$_}) {
+		if ($type) {
 			push @list, sprintf 'Тип сообщения %s удаляется', $_;
 		} else {
-			push @list, sprintf 'Тип сообщения %s не удаляется', $_;
+			unless (defined $type) {
+				push @list, sprintf 'Тип сообщения %s удаляется', $_;
+				$c->set ($_, 1, 'never');
+			} else {
+				push @list, sprintf 'Тип сообщения %s не удаляется', $_;
+			}
 		}
 	}
 
-	untie %censor;
-
 	return join "\n", @list;
 }
 
@@ -185,44 +121,35 @@ sub fortune_toggle (@) {
 	my $action = shift // undef;
 	my $phrase = 'Фортунка с утра ';
 
-	unless (-d $dir) {
-		make_path ($dir)  ||  do {
-			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
-			return;
-		};
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'fortune'
+	);
 
-	my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir;
-
-	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
-		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
-		return;
-	};
-
-	my $state = $toggle{$chatid};
+	my $state = $cache->get ($chatid);
 
 	if (defined $action) {
 		if ($action) {
-			$toggle{$chatid} = 1;
+			$cache->set ($chatid, 1, 'never');
 			$phrase .= 'будет показываться.';
 		} else {
 			if (defined $state) {
-				delete $toggle{$chatid};
+				$cache->remove ($chatid);
 			}
 
 			$phrase .= 'не будет показываться.';
 		}
 	} else {
 		if (defined $state && $state) {
-			delete $toggle{$chatid};
+			$cache->remove ($chatid);
 			$phrase .= 'не будет показываться.';
 		} else {
-			$toggle{$chatid} = 1;
+			$cache->set ($chatid, 1, 'never');
 			$phrase .= 'будет показываться.';
 		}
 	}
 
-	untie %toggle;
 	return $phrase;
 }
 
@@ -230,21 +157,13 @@ sub fortune_status ($) {
 	my $chatid = shift;
 	my $phrase = 'Фортунка с утра ';
 
-	unless (-d $dir) {
-		make_path ($dir)  ||  do {
-			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
-			return;
-		};
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'fortune'
+	);
 
-	my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir;
-
-	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
-		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
-		return;
-	};
-
-	my $state = $toggle{$chatid};
+	my $state = $cache->get ($chatid);
 
 	if (defined $state && $state) {
 		$phrase .= 'показывается.';
@@ -252,29 +171,17 @@ sub fortune_status ($) {
 		$phrase .= 'не показывается.';
 	}
 
-	untie %toggle;
 	return $phrase;
 }
 
 sub fortune_toggle_list () {
-	unless (-d $dir) {
-		make_path ($dir)  ||  do {
-			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
-			my @empty = ();
-			return @empty;
-		}
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'fortune'
+	);
 
-	my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir;
-
-	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
-		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
-		my @empty = ();
-		return @empty;
-	};
-
-	my @list = keys %toggle;
-	untie %toggle;
+	my @list = $cache->get_keys();
 	return @list;
 }
 
@@ -283,24 +190,13 @@ sub plugin_status (@) {
 	my $plugin = shift;
 	my $phrase = "Плагин $plugin ";
 
-	unless (-d $dir) {
-		make_path ($dir)  ||  do {
-			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
-			return;
-		};
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
+	);
 
-	my $backingfile = utf2sha1 $chatid;
-	$backingfile =~ s/\//-/xmsg;
-	$backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile;
-
-	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
-		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
-		return;
-	};
-
-	my $state = $toggle{$plugin};
-	untie %toggle;
+	my $state = $cache->get ($plugin);
 
 	if (defined $state && $state) {
 		$phrase .= 'включён.';
@@ -315,24 +211,13 @@ sub pluginEnabled (@) {
 	my $chatid = shift;
 	my $plugin = shift;
 
-	unless (-d $dir) {
-		make_path ($dir)  ||  do {
-			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
-			return;
-		};
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
+	);
 
-	my $backingfile = utf2sha1 $chatid;
-	$backingfile =~ s/\//-/xmsg;
-	$backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile;
-
-	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
-		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
-		return;
-	};
-
-	my $state = $toggle{$plugin};
-	untie %toggle;
+	my $state = $cache->get ($plugin);
 
 	if (defined $state && $state) {
 		return 1;
@@ -347,43 +232,32 @@ sub plugin_toggle (@) {
 	my $action = shift // undef;
 	my $phrase = "Плагин $plugin ";
 
-	unless (-d $dir) {
-		make_path ($dir)  ||  do {
-			cluck "[ERROR] Unable to create $dir: $OS_ERROR";
-			my @empty = ();
-			return @empty;
-		}
-	}
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
+	);
 
-	my $backingfile = utf2sha1 $chatid;
-	$backingfile =~ s/\//-/xmsg;
-	$backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile;
-
-	tie my %toggle, 'SQLite_File', $backingfile  ||  do {
-		cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
-		my @empty = ();
-		return @empty;
-	};
+	my $state = $cache->get ($plugin);
 
 	if (defined $action) {
 		if ($action) {
-			$toggle{$plugin} = 1;
+			$cache->set ($plugin, 1, 'never');
 			$phrase .= 'включён';
 		} else {
-			$toggle{$plugin} = 0;
+			$cache->set ($plugin, 0, 'never');
 			$phrase .= 'выключен';
 		}
 	} else {
-		if (defined ($toggle{$plugin}) && $toggle{$plugin}) {
-			$toggle{$plugin} = 0;
+		if (defined ($state) && $state) {
+			$cache->set ($plugin, 0, 'never');
 			$phrase .= 'включён';
 		} else {
-			$toggle{$plugin} = 1;
+			$cache->set ($plugin, 1, 'never');
 			$phrase .= 'выключен';
 		}
 	}
 
-	untie %toggle;
 	return $phrase;
 }