Compare commits
2 Commits
7e5fbba0d0
...
03a4a51a86
| Author | SHA1 | Date | |
|---|---|---|---|
|
03a4a51a86 | ||
|
|
de2106b16b |
@@ -15,10 +15,11 @@ use Data::Dumper qw (Dumper);
|
||||
use BotLib::Conf qw (LoadConf);
|
||||
use BotLib::Admin qw (@ForbiddenMessageTypes GetForbiddenTypes AddForbiddenType
|
||||
DelForbiddenType ListForbidden FortuneToggle FortuneStatus
|
||||
PluginToggle PluginStatus PluginEnabled ChanMsgToggle ChanMsgStatus);
|
||||
PluginToggle PluginStatus PluginEnabled ChanMsgToggle ChanMsgStatus
|
||||
GreetMsgToggle GreetMsgStatus GoodbyeMsgToggle GoodbyeMsgStatus);
|
||||
use BotLib::Util qw (trim);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use version; our $VERSION = qw (1.1);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (Command Highlight BotSleep IsCensored);
|
||||
|
||||
@@ -197,6 +198,14 @@ ${csign}admin fortune # - где 1 - вкл, 0 - выкл фортунку
|
||||
${csign}admin фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
${csign}admin fortune - показываем ли с утра фортунку для чата
|
||||
${csign}admin фортунка - показываем ли с утра фортунку для чата
|
||||
${csign}admin greet # - где 1 - вкл, 0 - выкл приветствия новых участников чата
|
||||
${csign}admin приветствие # - где 1 - вкл, 0 - выкл приветствия новых участников чата
|
||||
${csign}admin greet - приветствуем ли новых участников чата
|
||||
${csign}admin приветствие - приветствуем ли новых участников чата
|
||||
${csign}admin goodbye # - где 1 - вкл, 0 - выкл прощание с ушедшими участниками чата
|
||||
${csign}admin прощание # - где 1 - вкл, 0 - выкл прощание с ушедшими участниками чата
|
||||
${csign}admin goodbye - прощаемся ли с ушедшими участниками чата
|
||||
${csign}admin прощание - прощаемся ли с ушедшими участниками чата
|
||||
${csign}admin oboobs # - где 1 - вкл, 0 - выкл плагина oboobs
|
||||
${csign}admin oboobs - показываем ли сисечки по просьбе участников чата (команды ${csign}tits, ${csign}tities, ${csign}boobs, ${csign}boobies, ${csign}сиси, ${csign}сисечки)
|
||||
${csign}admin obutts # - где 1 - вкл, 0 - выкл плагина obutts
|
||||
@@ -272,6 +281,27 @@ MYADMIN
|
||||
} else {
|
||||
$reply = ChanMsgStatus ($chatid);
|
||||
}
|
||||
# Приветствуем ли мы новых участников чата
|
||||
} elsif ($cmd eq 'greet' || $cmd eq 'приветствие') {
|
||||
if (defined $args) {
|
||||
if ($args == 1) {
|
||||
$reply = GreetMsgToggle ($chatid, 1);
|
||||
} elsif ($args == 0) {
|
||||
$reply = GreetMsgToggle ($chatid, 0);
|
||||
}
|
||||
} else {
|
||||
$reply = GreetMsgStatus ($chatid);
|
||||
}
|
||||
} elsif ($cmd eq 'goodbye' || $cmd eq 'прощание') {
|
||||
if (defined $args) {
|
||||
if ($args == 1) {
|
||||
$reply = GoodbyeMsgToggle ($chatid, 1);
|
||||
} elsif ($args == 0) {
|
||||
$reply = GoodbyeMsgToggle ($chatid, 0);
|
||||
}
|
||||
} else {
|
||||
$reply = GoodbyeMsgStatus ($chatid);
|
||||
}
|
||||
# Работает ли плагин oboobs в чатике
|
||||
} elsif ($cmd eq 'oboobs') {
|
||||
if (defined $args) {
|
||||
|
||||
@@ -11,13 +11,14 @@ use CHI::Driver::BerkeleyDB ();
|
||||
use BotLib::Conf qw (LoadConf);
|
||||
use BotLib::Util qw (utf2sha1);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use version; our $VERSION = qw (1.1);
|
||||
use Exporter qw (import);
|
||||
# to export array we need @ISA here
|
||||
our @ISA = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA)
|
||||
our @EXPORT_OK = qw (@ForbiddenMessageTypes @PluginList GetForbiddenTypes AddForbiddenType DelForbiddenType
|
||||
ListForbidden FortuneToggle FortuneToggleList FortuneStatus PluginToggle PluginStatus
|
||||
PluginEnabled ChanMsgToggle ChanMsgStatus ChanMsgEnabled);
|
||||
PluginEnabled ChanMsgToggle ChanMsgStatus ChanMsgEnabled GreetMsgToggle GreetMsgStatus
|
||||
GreetMsgEnabled GoodbyeMsgToggle GoodbyeMsgStatus GoodbyeMsgEnabled);
|
||||
|
||||
my $c = LoadConf ();
|
||||
my $cachedir = $c->{cachedir};
|
||||
@@ -276,6 +277,183 @@ sub ChanMsgToggleList () {
|
||||
return $cache->get_keys ();
|
||||
}
|
||||
|
||||
sub GreetMsgToggle (@) {
|
||||
my $chatid = shift;
|
||||
my $action = shift // undef;
|
||||
my $phrase = 'Приветствия новых участников чата ';
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . 'greet_msg',
|
||||
);
|
||||
|
||||
my $state = $cache->get ($chatid);
|
||||
|
||||
if (defined $action) {
|
||||
if ($action) {
|
||||
$cache->set ($chatid, 1, 'never');
|
||||
$phrase .= 'включены.';
|
||||
} else {
|
||||
if (defined $state && $state) {
|
||||
$cache->set ($chatid, 0, 'never');
|
||||
$phrase .= 'выключены.';
|
||||
} else {
|
||||
$cache->set ($chatid, 1, 'never');
|
||||
$phrase .= 'включены.';
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (defined $state){
|
||||
if ($state) {
|
||||
$cache->set ($chatid, 0, 'never');
|
||||
$phrase .= 'выключены.';
|
||||
} else {
|
||||
$cache->set ($chatid, 1, 'never');
|
||||
$phrase .= 'включены.';
|
||||
}
|
||||
} else {
|
||||
$cache->set ($chatid, 1, 'never');
|
||||
$phrase .= 'выключены.';
|
||||
}
|
||||
}
|
||||
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
sub GreetMsgStatus ($) {
|
||||
my $chatid = shift;
|
||||
my $phrase = 'Приветствия новых участников чата ';
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . 'greet_msg',
|
||||
);
|
||||
|
||||
my $state = $cache->get ($chatid);
|
||||
|
||||
if (defined $state) {
|
||||
if ($state) {
|
||||
$phrase .= 'включены.';
|
||||
} else {
|
||||
$phrase .= 'выключены.';
|
||||
}
|
||||
} else {
|
||||
$phrase .= 'включены.';
|
||||
}
|
||||
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
sub GreetMsgEnabled ($) {
|
||||
my $chatid = shift;
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . 'greet_msg',
|
||||
);
|
||||
|
||||
my $state = $cache->get ($chatid);
|
||||
|
||||
if (defined $state) {
|
||||
if ($state) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
sub GoodbyeMsgToggle (@) {
|
||||
my $chatid = shift;
|
||||
my $action = shift // undef;
|
||||
my $phrase = 'Прощание с ушедшими участниками чата ';
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . 'goodbye_msg',
|
||||
);
|
||||
|
||||
my $state = $cache->get ($chatid);
|
||||
|
||||
if (defined $action) {
|
||||
if ($action) {
|
||||
$cache->set ($chatid, 1, 'never');
|
||||
$phrase .= 'включены.';
|
||||
} else {
|
||||
$cache->set ($chatid, 0, 'never');
|
||||
$phrase .= 'выключены.';
|
||||
}
|
||||
} else {
|
||||
if (defined $state){
|
||||
if ($state) {
|
||||
$cache->set ($chatid, 0, 'never');
|
||||
$phrase .= 'выключены.';
|
||||
} else {
|
||||
$cache->set ($chatid, 1, 'never');
|
||||
$phrase .= 'включены.';
|
||||
}
|
||||
} else {
|
||||
$cache->set ($chatid, 1, 'never');
|
||||
$phrase .= 'включены.';
|
||||
}
|
||||
}
|
||||
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
sub GoodbyeMsgStatus ($) {
|
||||
my $chatid = shift;
|
||||
my $phrase = 'Прощание с ушедшими участниками чата ';
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . 'goodbye_msg',
|
||||
);
|
||||
|
||||
my $state = $cache->get ($chatid);
|
||||
|
||||
if (defined $state) {
|
||||
if ($state) {
|
||||
$phrase .= 'включены.';
|
||||
} else {
|
||||
$phrase .= 'выключены.';
|
||||
}
|
||||
} else {
|
||||
$phrase .= 'выключены.';
|
||||
}
|
||||
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
sub GoodbyeMsgEnabled ($) {
|
||||
my $chatid = shift;
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . 'goodbye_msg',
|
||||
);
|
||||
|
||||
my $state = $cache->get ($chatid);
|
||||
|
||||
if (defined $state) {
|
||||
if ($state) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub PluginStatus (@) {
|
||||
my $chatid = shift;
|
||||
my $plugin = shift;
|
||||
|
||||
@@ -12,7 +12,7 @@ use Log::Any qw ($log);
|
||||
use Math::Random::Secure qw (irand);
|
||||
use Mojo::Base 'Teapot::Bot::Brain';
|
||||
|
||||
use BotLib::Admin qw (FortuneToggleList ChanMsgEnabled);
|
||||
use BotLib::Admin qw (FortuneToggleList ChanMsgEnabled GreetMsgEnabled GoodbyeMsgEnabled);
|
||||
use BotLib qw (Command Highlight BotSleep IsCensored);
|
||||
use BotLib::Conf qw (LoadConf);
|
||||
use BotLib::Util qw (trim fmatch);
|
||||
@@ -127,6 +127,11 @@ sub __on_msg {
|
||||
|
||||
# Newcommer event, greet our new member and suggest to introduce themself.
|
||||
if ($msg->can ('new_chat_members') && defined ($msg->new_chat_members)) {
|
||||
|
||||
unless (GreetMsgEnabled ($chatid)) {
|
||||
return;
|
||||
}
|
||||
|
||||
my @members;
|
||||
my @introduce = (
|
||||
'Дратути',
|
||||
@@ -173,6 +178,48 @@ sub __on_msg {
|
||||
return;
|
||||
}
|
||||
|
||||
# Leaving event, say goodbye to member just left chat
|
||||
if ($msg->can ('left_chat_member') && defined ($msg->left_chat_member)) {
|
||||
unless (GoodbyeMsgEnabled ($chatid)) {
|
||||
return;
|
||||
}
|
||||
|
||||
my @goodbye = (
|
||||
'Чат покинул(а) %s',
|
||||
'Из чата вышел(ла) %s',
|
||||
'До свидания, %s, приходите ещё',
|
||||
'Покеда, %s',
|
||||
'Удачи тебе, %s',
|
||||
'Бывай, %s',
|
||||
);
|
||||
|
||||
my $member = $msg->left_chat_member;
|
||||
my $member_str = '';
|
||||
|
||||
# avoid naming people by spacing symbols, or empty names
|
||||
if ($member->can ('first_name') && defined ($member->first_name) && $member->first_name !~ /^\s+$/ui) {
|
||||
$member_str .= $member->first_name;
|
||||
|
||||
if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
|
||||
$member_str .= ' ' . $member->last_name;
|
||||
}
|
||||
} else {
|
||||
if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
|
||||
$member_str .= ' ' . $member->last_name;
|
||||
# username must be uniq and should contain only english letters and numbers, so...
|
||||
} elsif ($member->can ('username') && defined ($member->username)) {
|
||||
$member_str .= '@' . $member->username;
|
||||
# fallback to id if uose trying to be smartass and use only spacing chars in it's firstname and/or lastname
|
||||
} else {
|
||||
$member_str .= $member->id;
|
||||
}
|
||||
}
|
||||
|
||||
my $leftuser = sprintf '[%s](tg://user?id=%s)', $member_str, $member->id;
|
||||
$phrase = sprintf $goodbye[irand ($#goodbye + 1)], $leftuser;
|
||||
$msg->replyMd ($phrase);
|
||||
return;
|
||||
}
|
||||
# is this a 1-on-1 ?
|
||||
if ($msg->chat->type eq 'private') {
|
||||
unless (defined $msg->text) {
|
||||
|
||||
Reference in New Issue
Block a user