Move admin commands to dedicated module, allow use admin stuff only to admins of chat
This commit is contained in:
eleksir
260
lib/admin.pm
Normal file
260
lib/admin.pm
Normal file
@@ -0,0 +1,260 @@
|
||||
package admin;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
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 conf qw (loadConf);
|
||||
use util qw (utf2sha1);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @ISA = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA)
|
||||
our @EXPORT_OK = qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status);
|
||||
|
||||
my $c = loadConf ();
|
||||
my $dir = $c->{admin}->{dir};
|
||||
my @forbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document);
|
||||
|
||||
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;
|
||||
|
||||
my $messageTypes;
|
||||
my $backingfile = utf2sha1 $chatid;
|
||||
$backingfile =~ s/\//-/xmsg;
|
||||
$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
|
||||
|
||||
unless (-f $backingfile) {
|
||||
initCensorDB ($backingfile);
|
||||
}
|
||||
|
||||
unless (tie my %censor, 'SQLite_File', $backingfile) {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR";
|
||||
return $messageTypes;
|
||||
}
|
||||
|
||||
foreach (keys %censor) {
|
||||
if ($censor{$_}) {
|
||||
$messageTypes->{$_} = 1;
|
||||
} else {
|
||||
$messageTypes->{$_} = 0;
|
||||
}
|
||||
}
|
||||
|
||||
untie %censor;
|
||||
return $messageTypes;
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
unless (tie my %censor, 'SQLite_File', $backingfile) {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR";
|
||||
return;
|
||||
}
|
||||
|
||||
$censor{$type} = 1;
|
||||
untie %censor;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
unless (tie my %censor, 'SQLite_File', $backingfile) {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR";
|
||||
return;
|
||||
}
|
||||
|
||||
$censor{$type} = 0;
|
||||
untie %censor;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub listForbidden {
|
||||
my $chatid = shift;
|
||||
|
||||
my @list;
|
||||
my $backingfile = utf2sha1 $chatid;
|
||||
$backingfile =~ s/\//-/xmsg;
|
||||
$backingfile = sprintf '%s/censor_%s.db', $dir, $backingfile;
|
||||
|
||||
unless (-f $backingfile) {
|
||||
initCensorDB ($backingfile);
|
||||
}
|
||||
|
||||
# FIXME: return list with all types alowed
|
||||
unless (tie my %censor, 'SQLite_File', $backingfile) {
|
||||
cluck "Unable to tie to $backingfile: $OS_ERROR";
|
||||
return '';
|
||||
}
|
||||
|
||||
foreach (keys %censor) {
|
||||
if ($censor{$_}) {
|
||||
push @list, sprintf 'Тип сообщения %s удаляется', $_;
|
||||
} else {
|
||||
push @list, sprintf 'Тип сообщения %s не удаляется', $_;
|
||||
}
|
||||
}
|
||||
|
||||
untie %censor;
|
||||
|
||||
return join "\n", @list;
|
||||
}
|
||||
|
||||
sub fortune_toggle (@) {
|
||||
my $chatid = shift;
|
||||
my $action = shift // undef;
|
||||
my $phrase = 'Фортунка с утра ';
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) || do {
|
||||
cluck "[ERROR] Unable to create $dir: $OS_ERROR";
|
||||
return;
|
||||
};
|
||||
}
|
||||
|
||||
my $backingfile = sprintf '%s/chats.sqlite', $dir;
|
||||
|
||||
tie my %toggle, 'SQLite_File', $backingfile || do {
|
||||
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
|
||||
return;
|
||||
};
|
||||
|
||||
my $state = $toggle{$chatid};
|
||||
|
||||
if (defined $action) {
|
||||
if ($action) {
|
||||
$toggle{$chatid} = 1;
|
||||
$phrase .= 'будет показываться.';
|
||||
} else {
|
||||
if (defined $state) {
|
||||
delete $toggle{$chatid};
|
||||
}
|
||||
|
||||
$phrase .= 'не будет показываться.';
|
||||
}
|
||||
} else {
|
||||
if (defined $state && $state) {
|
||||
delete $toggle{$chatid};
|
||||
$phrase .= 'не будет показываться.';
|
||||
} else {
|
||||
$toggle{$chatid} = 1;
|
||||
$phrase .= 'будет показываться.';
|
||||
}
|
||||
}
|
||||
|
||||
untie %toggle;
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
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 $backingfile = sprintf '%s/chats.sqlite', $dir;
|
||||
|
||||
tie my %toggle, 'SQLite_File', $backingfile || do {
|
||||
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
return;
|
||||
};
|
||||
|
||||
my $state = $toggle{$chatid};
|
||||
|
||||
if (defined $state && $state) {
|
||||
$phrase .= 'показывается.';
|
||||
} else {
|
||||
$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 $backingfile = sprintf '%s/chats.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;
|
||||
return @list;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
@@ -11,9 +11,10 @@ use Carp qw (carp);
|
||||
use Math::Random::Secure qw (irand);
|
||||
|
||||
use conf qw (loadConf);
|
||||
use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status);
|
||||
use archeologist qw (dig);
|
||||
use fisher qw (fish);
|
||||
use fortune qw (fortune fortune_toggle fortune_status);
|
||||
use fortune qw (fortune);
|
||||
use friday qw (friday);
|
||||
use karma qw (karmaSet karmaGet);
|
||||
use kitty qw (kitty);
|
||||
@@ -23,7 +24,7 @@ use weather qw (weather);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep);
|
||||
our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep isCensored);
|
||||
|
||||
my $c = loadConf ();
|
||||
my $csign = $c->{telegrambot}->{csign};
|
||||
@@ -93,12 +94,6 @@ sub command {
|
||||
$reply = sprintf "```\n%s\n```\n", trim (fortune ());
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'f 1' || substr ($text, 1) eq 'fortune 1' || substr ($text, 1) eq 'фортунка 1' || substr ($text, 1) eq 'ф 1') {
|
||||
$reply = fortune_toggle ($chatid, 1);
|
||||
} elsif (substr ($text, 1) eq 'f 0' || substr ($text, 1) eq 'fortune 0' || substr ($text, 1) eq 'фортунка 0' || substr ($text, 1) eq 'ф 0') {
|
||||
$reply = fortune_toggle ($chatid, 0);
|
||||
} elsif (substr ($text, 1) eq 'f ?' || substr ($text, 1) eq 'fortune ?' || substr ($text, 1) eq 'фортунка ?' || substr ($text, 1) eq 'ф ?') {
|
||||
$reply = fortune_status ($chatid);
|
||||
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
|
||||
$reply = dig $highlight;
|
||||
$msg->typing ();
|
||||
@@ -121,10 +116,6 @@ ${csign}fish | ${csign}рыба | ${csign}рыбка - порыбачить
|
||||
${csign}fishing | ${csign}рыбалка - порыбачить
|
||||
${csign}f | ${csign}ф - рандомная фраза из сборника цитат fortune_mod
|
||||
${csign}fortune | ${csign}фортунка - рандомная фраза из сборника цитат fortune_mod
|
||||
${csign}f # | ${csign}ф # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
${csign}fortune # | ${csign}фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
${csign}f ? | ${csign}ф ? - показываем ли с утра фортунку для чата
|
||||
${csign}fortune ? | ${csign}фортунка ? - показываем ли с утра фортунку для чата
|
||||
${csign}friday | ${csign}пятница - а не пятница ли сегодня?
|
||||
${csign}lat | ${csign}лат - сгенерить фразу из крылатых латинских выражений
|
||||
${csign}ping | ${csign}пинг - попинговать бота
|
||||
@@ -138,6 +129,71 @@ ${csign}karma фраза | ${csign}карма фраза - посмотреть
|
||||
MYHELP
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'admin' || substr ($text, 1) eq 'админ') {
|
||||
my $member = $self->getChatMember ($msg->from->id);
|
||||
|
||||
# this msg should be shown only if admins of chat request it
|
||||
if ($member->status eq 'administrator') || ($member->status eq 'creator') {
|
||||
$reply = << "MYADMIN";
|
||||
```
|
||||
${csign}admin censor type # - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений
|
||||
${csign}админ ценз тип # - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений
|
||||
${csign}admin censor - показать список состояния типов сообщений
|
||||
${csign}админ ценз - показать список состояния типов сообщений
|
||||
${csign}admin fortune # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
${csign}admin фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
${csign}admin fortune - показываем ли с утра фортунку для чата
|
||||
${csign}admin фортунка - показываем ли с утра фортунку для чата
|
||||
```
|
||||
Типы сообщений:
|
||||
audio voice photo video video_note animation sticker dice game poll document
|
||||
MYADMIN
|
||||
$msg->replyMd ($reply);
|
||||
}
|
||||
|
||||
return;
|
||||
} elsif ((substr ($text, 1, 5) eq 'admin' || substr ($text, 1, 5) eq 'админ') and (length ($text >= 8))) {
|
||||
my $member = $self->getChatMember ($msg->from->id);
|
||||
|
||||
# this msg should be shown only if admins of chat request it
|
||||
if ($member->status eq 'administrator') || ($member->status eq 'creator') {
|
||||
my $command = trim (substr $text, 7);
|
||||
my ($cmd, $args) = split /\s+/, $command, 2;
|
||||
|
||||
if ($cmd eq '') {
|
||||
return;
|
||||
} elsif ($cmd eq 'censor' || $cmd eq 'ценз') {
|
||||
if (defined $args && args ne '') {
|
||||
my ($msgType, $toggle) = split /\s/, $args;
|
||||
|
||||
if (defined $toggle) {
|
||||
foreach (@forbiddenMessageTypes) {
|
||||
if ($msgType eq $_) {
|
||||
if ($toggle == 1) {
|
||||
addForbiddenType ($chatid, $msgType);
|
||||
$reply = "Теперь сообщения с $msgType будут автоматически удаляться";
|
||||
} elsif ($toggle == 0) {
|
||||
delForbiddenType ($chatid, $msgType);
|
||||
$reply = "Теперь сообщения с $msgType будут оставаться";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
} else {
|
||||
$reply = listForbidden ($chatid);
|
||||
}
|
||||
} elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') {
|
||||
if (defined $args) {
|
||||
if ($args == 1) {
|
||||
$reply = fortune_toggle ($chatid, 1);
|
||||
} elsif ($args == 0) {
|
||||
$reply = fortune_toggle ($chatid, 0);
|
||||
}
|
||||
} else {
|
||||
$reply = fortune_status ($chatid);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $reply;
|
||||
@@ -201,6 +257,20 @@ sub botsleep {
|
||||
return;
|
||||
}
|
||||
|
||||
sub isCensored {
|
||||
my $msg = shift;
|
||||
|
||||
$forbidden = getForbiddenTypes ($msg->{chat}->{id});
|
||||
|
||||
foreach (keys %{%forbidden}) {
|
||||
if ($forbidden->{$_} && $msg->can ($_) && (defined $msg->{$_})) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
|
||||
100
lib/fortune.pm
100
lib/fortune.pm
@@ -15,7 +15,7 @@ use conf qw (loadConf);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (seed fortune fortune_toggle fortune_toggle_list fortune_status);
|
||||
our @EXPORT_OK = qw (seed fortune);
|
||||
|
||||
my $c = loadConf ();
|
||||
my $dir = $c->{fortune}->{dir};
|
||||
@@ -80,104 +80,6 @@ sub fortune () {
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
sub fortune_toggle (@) {
|
||||
my $chatid = shift;
|
||||
my $action = shift // undef;
|
||||
my $phrase = 'Фортунка с утра ';
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) || do {
|
||||
cluck "[ERROR] Unable to create $dir: $OS_ERROR";
|
||||
return;
|
||||
};
|
||||
}
|
||||
|
||||
my $backingfile = sprintf '%s/chats.sqlite', $dir;
|
||||
|
||||
tie my %toggle, 'SQLite_File', $backingfile || do {
|
||||
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
|
||||
return;
|
||||
};
|
||||
|
||||
my $state = $toggle{$chatid};
|
||||
|
||||
if (defined $action) {
|
||||
if ($action) {
|
||||
$toggle{$chatid} = 1;
|
||||
$phrase .= 'будет показываться.';
|
||||
} else {
|
||||
if (defined $state) {
|
||||
delete $toggle{$chatid};
|
||||
}
|
||||
|
||||
$phrase .= 'не будет показываться.';
|
||||
}
|
||||
} else {
|
||||
if (defined $state && $state) {
|
||||
delete $toggle{$chatid};
|
||||
$phrase .= 'не будет показываться.';
|
||||
} else {
|
||||
$toggle{$chatid} = 1;
|
||||
$phrase .= 'будет показываться.';
|
||||
}
|
||||
}
|
||||
|
||||
untie %toggle;
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
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 $backingfile = sprintf '%s/chats.sqlite', $dir;
|
||||
|
||||
tie my %toggle, 'SQLite_File', $backingfile || do {
|
||||
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
|
||||
return;
|
||||
};
|
||||
|
||||
my $state = $toggle{$chatid};
|
||||
|
||||
if (defined $state && $state) {
|
||||
$phrase .= 'показывается.';
|
||||
} else {
|
||||
$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 $backingfile = sprintf '%s/chats.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;
|
||||
return @list;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
|
||||
@@ -13,9 +13,10 @@ use File::Path qw (make_path);
|
||||
use Hailo;
|
||||
use Math::Random::Secure qw (irand);
|
||||
use Mojo::Base 'Teapot::Bot::Brain';
|
||||
use botlib qw (randomCommonPhrase command highlight botsleep);
|
||||
use admin qw (fortune_toggle_list);
|
||||
use botlib qw (randomCommonPhrase command highlight botsleep isCensored);
|
||||
use conf qw (loadConf);
|
||||
use fortune qw (fortune fortune_toggle_list);
|
||||
use fortune qw (fortune);
|
||||
use karma qw (karmaSet);
|
||||
use util qw (trim fmatch);
|
||||
|
||||
@@ -51,7 +52,7 @@ sub __cron {
|
||||
$send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (fortune ());
|
||||
$send_args->{chat_id} = $enabledfortunechat;
|
||||
$send_args->{parse_mode} = 'Markdown';
|
||||
Teapot::Bot::Brain::sendMessage ($self, $send_args);
|
||||
$self->sendMessage ($send_args);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -68,7 +69,7 @@ sub __on_msg {
|
||||
my $csign = $c->{telegrambot}->{csign};
|
||||
|
||||
unless ($myid) {
|
||||
my $myObj = Teapot::Bot::Brain::getMe ($self);
|
||||
my $myObj = $self->getMe ();
|
||||
|
||||
unless ($myObj) {
|
||||
carp '[ERROR] Unable to get chatid, API Error?';
|
||||
@@ -212,13 +213,18 @@ sub __on_msg {
|
||||
if (defined $reply) {
|
||||
$msg->typing ();
|
||||
sleep 1;
|
||||
carp sprintf ("[DEBUG] Private chat bot reply to $vis_a_vi: %s", $reply) if $c->{debug};
|
||||
carp sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply) if $c->{debug};
|
||||
$msg->reply ($reply);
|
||||
}
|
||||
# group chat
|
||||
} elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
|
||||
my $reply;
|
||||
|
||||
if (isCensored $msg) {
|
||||
carp '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi;
|
||||
$self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});
|
||||
}
|
||||
|
||||
# detect and log messages without text, noop here
|
||||
unless (defined $msg->text) {
|
||||
carp sprintf ('[INFO] No text in message from %s', $vis_a_vi);
|
||||
|
||||
Reference in New Issue
Block a user