1

21 Commits

Author SHA1 Message Date
eleksir
cec2f2f875 Use ->canTalk() instead of ::canTalk() in Message.pm as it is more reliable way to check this 2022-02-03 02:03:50 +03:00
eleksir
a4d0afab5d Use JSON::PP explicitly rather than implicitly 2022-02-03 02:00:06 +03:00
eleksir
75d0e07c6d Fix error handling in canDeleteMessage 2022-02-03 00:42:13 +03:00
eleksir
b503fec769 Fix error handling in canTalk() 2022-02-03 00:29:26 +03:00
eleksir
c9e664b4e5 Update readmes about runtime environment 2022-01-29 18:10:56 +03:00
eleksir
e552ecbf00 Pin versions in cpanfile 2022-01-29 18:06:23 +03:00
eleksir
ea634710f1 In newcommer greeting treat space-char-only first_name or last_name as non-existing 2022-01-29 17:32:25 +03:00
eleksir
e784a78979 Use all types of greet phrases to omit answer if newcommer respond to our greet with quotation 2022-01-29 17:21:04 +03:00
eleksir
b992698b9b Add easter egg phrases in private and group conversations, fix previous addition of private phrases a bit 2021-12-25 15:41:20 +03:00
eleksir
8d21991af6 Put disclaimer about feature freeze and update help message with relevant software version text 2021-12-20 00:01:43 +03:00
eleksir
f223ba04ae Extend weather command list, add !weather, !погода, !погадка, !погодка, also allow oboobs and obutts plugins in private conversation 2021-12-18 17:24:21 +03:00
eleksir
8d35bb2452 Update api with fields from v5.4 and v5.5 2021-12-07 20:11:56 +03:00
eleksir
71a2471725 Couple of grammar and coding style mistakes fixes here and there 2021-12-04 03:10:41 +03:00
eleksir
e93c9f9131 Use different hello-phrases to greet newcommers 2021-12-03 20:25:51 +03:00
eleksir
1abb95622a Fix bunch of grammar mistakes 2021-10-17 01:14:38 +03:00
eleksir
bb399a5051 Add undocumented commands !kde and !кде 2021-10-12 10:54:30 +03:00
eleksir
c5014a8f77 Weather.pm: Hardcode popular russian short city names 2021-10-01 13:23:00 +03:00
eleksir
f83a2d3436 Anek.pm: fix rare case when fetched response is unparsable 2021-08-16 00:03:38 +03:00
eleksir
2134edd841 Implemented !proverb and !пословица commands 2021-08-11 16:54:21 +03:00
eleksir
3dd565c658 Implemented !coin !монетка !roll !dies !кости commands 2021-08-11 13:19:56 +03:00
eleksir
7147b785e7 Add !anek !анек !анекдот commands 2021-07-29 21:26:59 +03:00
25 changed files with 2256 additions and 189 deletions

1
.gitignore vendored
View File

@@ -11,5 +11,6 @@ data/gamestat/**
data/image/** data/image/**
data/karma/** data/karma/**
data/lat/** data/lat/**
data/proverb/**
data/telegrambot-brains/** data/telegrambot-brains/**
vendor_perl/** vendor_perl/**

View File

@@ -52,7 +52,7 @@ verbose = 8
[-ValuesAndExpressions::ProhibitEmptyQuotes] [-ValuesAndExpressions::ProhibitEmptyQuotes]
# cause we consider following correct and useful: my $var = ''; # cause we consider following correct and useful: my $var = '';
# the recomended use of q{} looks too complex: my $var = q{}; # the recommended use of q{} looks too complex: my $var = q{};
[-ValuesAndExpressions::ProhibitNoisyQuotes] [-ValuesAndExpressions::ProhibitNoisyQuotes]
# Other people, other opinions: "," is better readable than qw(,) # Other people, other opinions: "," is better readable than qw(,)
@@ -92,4 +92,3 @@ lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
[-ControlStructures::ProhibitDeepNests] [-ControlStructures::ProhibitDeepNests]
# Have to use it, so fuckoff # Have to use it, so fuckoff

View File

@@ -7,10 +7,10 @@ When you require to perform this procedure?
Why do i have to perform this procedure? Why do i have to perform this procedure?
- Some modules are vendored with bot - Some modules are vendored with bot
- BDB can vary its on-disk format depending on dbd version that linked with - BDB can vary its on-disk format depending on dbd version that linked with
perl interpreter itself and its apropriate module. perl interpreter itself and its appropriate module.
How can i guess that i miss to perform this procedure? How can i guess that i miss to perform this procedure?
Most notable sympthom is 'BDB0091 DB_VERSION_MISMATCH' in logs and bot admin settings are lost. Most notable symptom is 'BDB0091 DB_VERSION_MISMATCH' in logs and bot admin settings are lost.
Procedure steps. Procedure steps.
@@ -22,8 +22,8 @@ On source system perform following steps:
On target system perform these steps: On target system perform these steps:
1. remove vendor_perl dir in bot' directory 1. remove vendor_perl dir in bot' directory
2. run "bash bootstrap.sh" (no quotes) and wait until it suscessfuly build and 2. run "bash bootstrap.sh" (no quotes) and wait until it successfully build and
installl required modules. install required modules.
3. run perl bin/cache_import.pl script. It should create cache and exit 3. run perl bin/cache_import.pl script. It should create cache and exit
silently. silently.

View File

@@ -1,29 +1,32 @@
# Aleesa-Telegram-bot - Telegram chatty bot # Aleesa-Telegram-bot - Telegram chatty bot
## Disclaimer
This version - 3 (something) - considered stable. It means that further development of new features kind of frosen.
Most effort will be targeted to future 4-th version development. If you have some ideas or fixes to this version
feel free PR them, they will be merged as soon as being reviewed.
## About ## About
It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation generator.
generator.
I have to fork [Telegram::Bot][1] and update it according to features appeared I have to fork [Telegram::Bot][1] and update it according to features appeared in [Telegram Bot API v5][3]. Also,
in [Telegram Bot API v5][3]. Also, I decide to rename it to avoid collision in I decide to rename it to avoid collision in the future, now it is Teapot::Bot and is bundled with bot. When lib becomes
the future, now it is Teapot::Bot and is bundled with bot. When lib becomes
mature enough, maybe I release it separately. mature enough, maybe I release it separately.
Bot config located in **data/config.json**, sample config provided as Bot config located in **data/config.json**, sample config provided as **data/sample_config.json**.
**data/sample_config.json**.
Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon (double fork() Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon (double fork() and detaches stdio).
and detaches stdio).
## Installation ## Installation
In order to run this application, you need to "bootstrap" it - download and build Application have been tested on alpine linux x86_64 3.12, with perl-5.32.1 builtin.
all required dependencies and libraries.
You'll need perl-5.18 or newer, "Development Tools" or similar group of In order to run this application, you need to "bootstrap" it - download and build all required dependencies and
packages, perl, perl-devel, perl-local-lib, perl-app-cpanm, sqlite-devel, libraries.
zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
You'll need perl-5.18 or newer, "Development Tools" or similar group of packages, perl, perl-devel, perl-local-lib,
perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
After installing required dependencies it is possible to run: After installing required dependencies it is possible to run:
@@ -37,56 +40,49 @@ and all libraries should be downloaded, built, tested and installed.
## Running ## Running
This bot does not [ultilize][4] webhooks, so in order to run it only well This bot does not [ultilize][4] webhooks, so in order to run it only well internet connection is required, no
internet connection is requied, no public-available ip address is needed. public-available ip address is needed.
### Additional Settings to be performed in order to run bot as it designed ### Additional Settings to be performed in order to run bot as it designed
There are some "plugins" that requires registration on thrird party services There are some "plugins" that requires registration on third party services and API keys and secrets in order to work.
and API keys and secrets in order to work.
#### OpenWeatherMap #### OpenWeatherMap
You should [register][5], [login][6] and [create][7] api key. Free plan have You should [register][5], [login][6] and [create][7] api key. Free plan have all required features to run this "plugin".
all required features to run this "plugin".
Once key is created you should put it in **config.json** under openweathermap Once key is created you should put it in **config.json** under openweathermap section as appid. Thats it.
section as appid. Thats it.
It is still impossible to disable this plugin, but "I'm working on it". It is still impossible to disable this plugin, but "I'm working on it".
#### Imgur #### Imgur
This plugin "just exists" and is actually used nowhere around the code. This plugin "just exists" and is actually used nowhere around the code. Anyway, to make use of it besides registering
Anyway, to make use of it besides registering apropriate handler in code, you appropriate handler in code, you should sign in imgur and get access token.
should sign in imgur and get access token.
Actually at this time this "plugin" can be stub-ed with default config values. Actually at this time this "plugin" can be stub-ed with default config values.
Anyway, to fetch access token you should [login][8] and perform [registration][9] Anyway, to fetch access token you should [login][8] and perform [registration][9] of your app. Then you should
of your app. Then you should authorise your app according to [this][10] manual. Or authorize your app according to [this][10] manual. Or [this][11] one.
[this][11] one.
#### Flickr #### Flickr
This "plugin" is really used to implement random picture link retrival plugins. This "plugin" is really used to implement random picture link retrival plugins.
There is helper script in **bin/flickr_init.pl** that helps to get all required keys There is helper script in **bin/flickr_init.pl** that helps to get all required keys and secrets from flickr api.
and secrets from flickr api.
Before using it bot must be bootstrapped via **`bootstrap.sh`**. Before using it bot must be bootstrapped via **`bootstrap.sh`**.
[Login][11] and create an [app][12] in your flickr account. Then *logout* flickr account. [Login][11] and create an [app][12] in your flickr account. Then *logout* flickr account. (It is required in order to
(It is required in order to properly get "verfier" parameter later). properly get "verifier" parameter later).
Put your [app key and secret][13] to **config.json**. Ensure that "verifier" parameter Put your [app key and secret][13] to **config.json**. Ensure that "verifier" parameter in Flickr-related part of config
in Flickr-related part of config either absent or commented out. either absent or commented out.
Run **bin/flickr_init.pl** first time and follow on screen instuctions - copy and Run **bin/flickr_init.pl** first time and follow on screen instructions - copy and paste given link to browser login to
paste given link to browser login to flickr account adn yo'll be redirected to flickr account and you'll be redirected to example.com. Check address bar in browser to get so-called "verifier", put
example.com. Check address bar in browser to get so-called "verifier", put it in it in **config.json**. Then run **bin/flickr_init.pl** again to store API access token in db under data/image directory
**config.json**. Then run **bin/flickr_init.pl** again to store API access token in db (in default config). You're done.
under data/image directory (in default config). You're done.
[1]: https://metacpan.org/pod/Telegram::Bot [1]: https://metacpan.org/pod/Telegram::Bot
[2]: https://metacpan.org/pod/Hailo [2]: https://metacpan.org/pod/Hailo

View File

@@ -1,32 +1,38 @@
# Aleesa-Telegram-bot - Болтливый бот для Telegram # Aleesa-Telegram-bot - Болтливый бот для Telegram
## Дисклеймер
Эта версия бота за номером 3 (с мелочью) стабильная. Сие означает, что дальнейшего развития функций в этой версии не
предполагается. Конечно, возможны исключения, но основной план - переключиться на 4-ю версию, куда планируется
перенести большинство функций 3-й версии.
Если у кого-то возникнут идеи относительно этой версии бота - ставьте PR, я только рад. Т.к. несмотря на то, что
развитие этой версии "слегка" заморожено, поддерживать её планируется как минимум до выхода в свет 4-й версии бота.
## Что это такое ## Что это такое
Это бот основанный на перловых модулях [Telegram::Bot][1] для работы в Это бот, основанный на перловых модулях [Telegram::Bot][1] для работы в мессенджере Telegram и [Hailo][2] для генерации
мессенджере Telegram и [Hailo][2] для генерации "умной" беседы. "умной" беседы.
Для корректной работы пришлось форкнуть [Telegram::Bot][1] чтобы обновить Для корректной работы, пришлось форкнуть [Telegram::Bot][1], чтобы обновить интерфейс API до [Telegram Bot API v5][3].
интерфейс API до [Telegram Bot API v5][3]. Для избежания неоднозначностей модуль Для избежания неоднозначностей, модуль пришлось переименовать и теперь он идёт в составе бота. Возможно, когда модуль
пришлось переименовать и теперь он идёт в составе бота. Возможно, когда модуль отлежится и будет похож на стабильный, он стнет самостоятельным и поселится на metacpan.org
отлежится и будет похож на стабильный, он стнет самостоятельным и поселится на
metacpan.org
Конфиг бота должен лежать в **data/config.json**, пример конфига расположен в Конфиг бота должен лежать в **data/config.json**. Пример конфига расположен в **data/sample_config.json**.
**data/sample_config.json**.
Бота можно запустить через **bin/aleesa-telegram-bot** и он взлетит как юниксовый Бота можно запустить через **bin/aleesa-telegram-bot** и он взлетит, как юниксовый демон (сделает двойной fork() и
демон (сделает двойной fork() и отцепится от stdio). отцепится от stdio).
## Установка ## Установка
Чтобы запустить приложение, его надо "забурстрапить" - загрузить и собрать все Приложение тестировалось на alpine linux x86_64 3.12, со встроенным perl-5.32.1.
необходимые зависимости.
Понадобится perl-5.18 а желательно новее, "Development Tools" или подобная Чтобы запустить приложение, его надо "забурстрапить" - загрузить и собрать все необходимые зависимости.
группа пакетов , perl, perl-devel, perl-local-lib, perl-app-cpanm, sqlite-devel,
zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
После установки этих пакетов можно будет запустить: Понадобится perl-5.18, а желательно новее, "Development Tools" или подобная группа пакетов , perl, perl-devel,
perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make.
После установки этих пакетов, можно будет запустить:
```bash ```bash
@@ -34,60 +40,54 @@ bash bootstrap.sh
``` ```
и по идее всё что нужно будет выкачено, собрано и разложено куда надо. и, по идее, всё что нужно будет выкачено, собрано и разложено куда надо.
## Запуск и работа ## Запуск и работа
Бот не использует [вебхуки][4], поэтому ничего дополнительного, кроме хорошего Бот не использует [вебхуки][4], поэтому ничего дополнительного, кроме хорошего подключения к интернету ему не нужно.
подключения к интернету ему не нужно.
### Дополнительные настройки ### Дополнительные настройки
Некоторые "плагины" требуют регистрации в сторонних сервисах (API keys, secrets Некоторые "плагины" требуют регистрации в сторонних сервисах (API keys, secrets итд), чтобы бот не сыпал ошибками в
итд), чтобы бот не сыпал ошибками в логи (возможно, в дальнейшем возможно будет логи (возможно, в дальнейшем возможно будет отключить эти плагины).
отключить эти плагины).
#### OpenWeatherMap #### OpenWeatherMap
Для работы погодного плагина надо [заргистрироваться][5], [залогиниться][6] и Для работы погодного плагина, надо [заргистрироваться][5], [залогиниться][6] и [создать][7] api key. Free plan
[создать][7] api key. Free plan предлагает всё необхдимое для работы "плагина". предлагает всё необхдимое для работы "плагина".
Когда api key будет создан, его нужно вписать в **config.json** "секцию" Когда api key будет создан, его нужно вписать в **config.json** "секцию" openweathermap в качестве appid. На этом всё.
openweathermap в качестве appid. На этом всё.
#### Imgur #### Imgur
Этот плагин "просто есть" и его на самом деле ничто и никто не использует. И в Этот плагин "просто есть" и его на самом деле ничто и никто не использует. И в этой связи все настройки плагина можно
этой связи все настройки плагина можно оставить "как есть" в примере конфига. оставить "как есть" в примере конфига.
Тем не менее, если есть большое желание, то можно [залогиниться][8] и Тем не менее, если есть большое желание, то можно [залогиниться][8] и [зарегистрировать][9] бота как приложение, а
[зарегистрировать][9] бота как приложение, а потом разрешить приложению потом разрешить приложению пользоваться API-шкой, как описано в [этом][10] или [этом][11] мануале.
пользоваться API-шкой, как описано в [этом][10] или [этом][11] мануале.
#### Flickr #### Flickr
Этот "плагин" действительно используется для добычи ссылок на картинки в разных Этот "плагин" действительно используется для добычи ссылок на картинки в разных "картиночных" командах бота.
"картиночных" командах бота.
Есть скрипт, который поможет с регистрацией приложения в api Flickr - Есть скрипт, который поможет с регистрацией приложения в api Flickr - **bin/flickr_init.pl**, он достанет все нужные
**bin/flickr_init.pl** он достанет все нужные ключи и секреты к ним. ключи и секреты к ним.
До запуска этого скрипта, бот должен быть забутстраплен через **`bootstrap.sh`**. До запуска этого скрипта, бот должен быть забутстраплен через **`bootstrap.sh`**.
[Залогиньтесь][11] и создайте [app][12] in своём Flicker-овском аккаунте. Далее, [Залогиньтесь][11] и создайте [app][12] in своём Flicker-овском аккаунте. Далее, *разлогиньтесь*, это нужно, чтобы
*разлогиньтесь*, это нужно, чтобы потом проще было достать параметр verifier. потом проще было достать параметр verifier.
Запишите [app key и secret][13] в **config.json**. Удостоверьтесь, что параметр Запишите [app key и secret][13] в **config.json**. Удостоверьтесь, что параметр "verifier" в конфиге либо закоменчен,
"verifier" в конфиге либо закоменчен либо отсутствует. либо отсутствует.
Запустите **bin/flickr_init.pl** и следуте предлагаемым инструкциям - в итоге Запустите **bin/flickr_init.pl** и следуте предлагаемым инструкциям - в итоге будет дана ссылка, которую надо
будет дана ссылка, которую надо скопипастить в браузер. По ссылке предложат скопипастить в браузер. По ссылке предложат залогиниться, далее надо будет разрешить приложению просматривать профиль
залогиниться, далее надо будет разрешить приложению просматривать профиль и и, через один-два редиректа, вы попадёте на example.com. Из адресной строки браузера надо скопировать параметр
через один-два редиректа вы попадёте на example.com. Из адресной строки браузера "verifier" и вписать его в **config.json**.
надо скопировать параметр "verifier" и вписать его в **config.json**.
Чтобы сохранить в бд плагина API access token для нормальной работы "плагина", Чтобы сохранить в бд плагина API access token для нормальной работы "плагина", второй раз запустите
второй раз запустите **bin/flickr_init.pl**. На этом всё. **bin/flickr_init.pl**. На этом всё.
[1]: https://metacpan.org/pod/Telegram::Bot [1]: https://metacpan.org/pod/Telegram::Bot
[2]: https://metacpan.org/pod/Hailo [2]: https://metacpan.org/pod/Hailo

26
bin/proverb_seed.pl Normal file
View File

@@ -0,0 +1,26 @@
#!/usr/bin/perl
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use version; our $VERSION = qw (1.0);
my $workdir;
# before we run, change working dir
BEGIN {
use Cwd qw (chdir abs_path);
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
if ($#CWD > 1) { $#CWD = $#CWD - 2; }
$workdir = join '/', @CWD;
chdir $workdir;
}
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use BotLib::Proverb qw (Seed);
Seed ();
exit 0;

View File

@@ -1,34 +1,39 @@
requires 'Carp'; ## no critic (TestingAndDebugging::RequireUseStrict,Modules::RequireVersionVar)
requires 'CHI'; ## no critic (TestingAndDebugging::RequireUseWarnings,Modules::RequireExplicitPackage)
requires 'CHI::Driver::BerkeleyDB'; ## no critic (Modules::RequireEndWithOne)
requires 'Cwd::utf8'; requires 'Carp', '==1.50';
requires 'DateTime'; requires 'CHI', '==0.61';
requires 'DB_File'; requires 'CHI::Driver::BerkeleyDB', '==0.05';
requires 'SQLite_File'; requires 'Cwd::utf8', '==0.011';
requires 'DBI'; requires 'DateTime', '==1.55';
requires 'DBD::SQLite'; requires 'DB_File', '==1.856';
requires 'Digest::HMAC_SHA1'; requires 'SQLite_File', '==0.1006';
requires 'Digest::MD5'; requires 'DBI', '==1.643';
requires 'Data::Dumper'; requires 'DBD::SQLite', '==1.70';
requires 'Digest::SHA'; requires 'Digest::HMAC_SHA1', '==1.04';
requires 'File::Basename'; requires 'Digest::MD5', '==2.58';
requires 'File::Path'; requires 'Data::Dumper', '==2.183';
requires 'Hailo'; requires 'Digest::SHA', '==6.02';
requires 'HTML::TokeParser'; requires 'File::Basename', '==2.85';
requires 'IO::Socket::SSL'; requires 'File::Path', '==2.18';
requires 'JSON'; requires 'Hailo', '==0.75';
requires 'JSON::XS'; requires 'HTML::TokeParser', '==3.76';
requires 'List::Util'; requires 'IO::Socket::SSL', '==2.074';
requires 'local::lib'; requires 'JSON', '==4.05';
requires 'Log::Any'; requires 'JSON::PP', '==4.07';
requires 'Log::Any::Adapter'; requires 'JSON::XS', '==4.03';
requires 'Log::Any::For::Std'; requires 'List::Util', '==1.60';
requires 'Math::Random::Secure'; requires 'local::lib', '==2.000028';
requires 'Mojo::Base'; requires 'Log::Any', '==1.710';
requires 'Mojo::IOLoop'; requires 'Log::Any::Adapter', '==1.710';
requires 'Mojo::UserAgent'; requires 'Log::Any::For::Std', '==0.05';
requires 'Mojo::UserAgent::Cached'; requires 'Math::Random::Secure', '==0.080001';
requires 'String::Random'; requires 'Mojolicious', '==9.22';
requires 'Text::Fuzzy'; requires 'Mojo::Base', '0';
requires 'URI::Encode::XS'; requires 'Mojo::IOLoop', '0';
requires 'URI::URL'; requires 'Mojo::UserAgent', '0';
requires 'Mojo::UserAgent::Cached', '==1.18';
requires 'String::Random', '==0.32';
requires 'Text::Fuzzy', '==0.29';
requires 'URI::Encode::XS', '==0.11';
requires 'URI::URL', '==5.10';

1719
data/proverb_src/proverb.txt Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -12,6 +12,11 @@
"srcdir" : "data/fortune_src" "srcdir" : "data/fortune_src"
}, },
"proverb" : {
"dir" : "data/proverb",
"srcdir" : "data/proverb_src"
},
"friday" : { "friday" : {
"dir" : "data/friday", "dir" : "data/friday",
"src" : "data/friday.txt" "src" : "data/friday.txt"

View File

@@ -14,6 +14,7 @@ use BotLib::Conf qw (LoadConf);
use BotLib::Admin qw (@ForbiddenMessageTypes GetForbiddenTypes AddForbiddenType use BotLib::Admin qw (@ForbiddenMessageTypes GetForbiddenTypes AddForbiddenType
DelForbiddenType ListForbidden FortuneToggle FortuneStatus DelForbiddenType ListForbidden FortuneToggle FortuneStatus
PluginToggle PluginStatus PluginEnabled); PluginToggle PluginStatus PluginEnabled);
use BotLib::Anek qw (Anek);
use BotLib::Archeologist qw (Dig); use BotLib::Archeologist qw (Dig);
use BotLib::Buni qw (Buni); use BotLib::Buni qw (Buni);
use BotLib::Drink qw (Drink); use BotLib::Drink qw (Drink);
@@ -24,6 +25,7 @@ use BotLib::Image qw (Kitty Fox Oboobs Obutts Rabbit Owl Frog Horse Snail);
use BotLib::Karma qw (KarmaSet KarmaGet); use BotLib::Karma qw (KarmaSet KarmaGet);
use BotLib::Lat qw (Lat); use BotLib::Lat qw (Lat);
use BotLib::Monkeyuser qw (Monkeyuser); use BotLib::Monkeyuser qw (Monkeyuser);
use BotLib::Proverb qw (Proverb);
use BotLib::Util qw (trim); use BotLib::Util qw (trim);
use BotLib::Weather qw (Weather); use BotLib::Weather qw (Weather);
use BotLib::Xkcd qw (Xkcd); use BotLib::Xkcd qw (Xkcd);
@@ -43,7 +45,7 @@ sub RandomCommonPhrase {
'Повтори свой вопрос, не поняла', 'Повтори свой вопрос, не поняла',
'Выйди и зайди нормально', 'Выйди и зайди нормально',
'Я подумаю', 'Я подумаю',
'Даже не знаю что на это ответить', 'Даже не знаю, что на это ответить',
'Ты упал такие вопросы девочке задавать?', 'Ты упал такие вопросы девочке задавать?',
'Можно и так, но не уверена', 'Можно и так, но не уверена',
'А как ты думаешь?', 'А как ты думаешь?',
@@ -69,11 +71,43 @@ sub Command {
$reply = 'Wat?'; $reply = 'Wat?';
} elsif (substr ($text, 1) eq 'понг') { } elsif (substr ($text, 1) eq 'понг') {
$reply = 'Шта?'; $reply = 'Шта?';
} elsif (substr ($text, 1) eq 'coin' || substr ($text, 1) eq 'монетка') {
if (rand (101) < 0.016) {
$reply = 'ребро';
} else {
if (irand (2) == 0) {
if (irand (2) == 0) {
$reply = 'орёл';
} else {
$reply = 'аверс';
}
} else {
if (irand (2) == 0) {
$reply = 'решка';
} else {
$reply = 'реверс';
}
}
}
} elsif (substr ($text, 1) eq 'roll' || substr ($text, 1) eq 'dice' || substr ($text, 1) eq 'кости') {
$reply = sprintf 'На первой кости выпало %d, а на второй — %d.', irand (6) + 1, irand (6) + 1;
} elsif (substr ($text, 1) eq 'ver' || substr ($text, 1) eq 'version' || substr ($text, 1) eq 'версия') { } elsif (substr ($text, 1) eq 'ver' || substr ($text, 1) eq 'version' || substr ($text, 1) eq 'версия') {
$reply = 'Версия: Нуль.Чего-то_там.Чего-то_там'; $reply = 'Версия: Три.Чего-то_там.С_мелочью';
} elsif (substr ($text, 1) eq 'anek' || substr ($text, 1) eq 'анек' || substr ($text, 1) eq 'анекдот') {
$msg->typing ();
$reply = "```\n" . Anek () . "\n```";
sleep (irand (2) + 1);
$msg->replyMd ($reply);
return;
} elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) { } elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) {
my $city = substr $text, 3; my $city = substr $text, 3;
$reply = Weather $city; $reply = Weather $city;
} elsif (substr ($text, 1, 7) eq 'погода ') {
my $city = substr $text, 7;
$reply = Weather $city;
} elsif ((substr ($text, 1, 8) eq 'погодка ') || (substr ($text, 1, 8) eq 'погадка ') || (substr ($text, 1, 8) eq 'weather ')){
my $city = substr $text, 8;
$reply = Weather $city;
} elsif (substr ($text, 1) eq 'buni') { } elsif (substr ($text, 1) eq 'buni') {
$msg->typing (); $msg->typing ();
$reply = Buni (); $reply = Buni ();
@@ -150,11 +184,11 @@ sub Command {
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif ( } elsif (
substr ($text, 1) eq 'tits' || substr ($text, 1) eq 'tits' ||
substr ($text, 1) eq 'boobs' || substr ($text, 1) eq 'boobs' ||
substr ($text, 1) eq 'tities' || substr ($text, 1) eq 'tities' ||
substr ($text, 1) eq 'boobies' || substr ($text, 1) eq 'boobies' ||
substr ($text, 1) eq 'сиси' || substr ($text, 1) eq 'сиси' ||
substr ($text, 1) eq 'сисечки' substr ($text, 1) eq 'сисечки'
) { ) {
if (PluginEnabled $chatid, 'oboobs') { if (PluginEnabled $chatid, 'oboobs') {
@@ -167,8 +201,8 @@ sub Command {
return; return;
} elsif ( } elsif (
substr ($text, 1) eq 'butt' || substr ($text, 1) eq 'butt' ||
substr ($text, 1) eq 'booty' || substr ($text, 1) eq 'booty' ||
substr ($text, 1) eq 'ass' || substr ($text, 1) eq 'ass' ||
substr ($text, 1) eq 'попа' || substr ($text, 1) eq 'попа' ||
substr ($text, 1) eq 'попка' substr ($text, 1) eq 'попка'
) { ) {
@@ -182,6 +216,8 @@ sub Command {
return; return;
} elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') { } elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') {
$reply = Friday (); $reply = Friday ();
} elsif (substr ($text, 1) eq 'proverb' || substr ($text, 1) eq 'пословица') {
$reply = Proverb ();
} elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') { } elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') {
$reply = sprintf "```\n%s\n```\n", trim (Fortune ()); $reply = sprintf "```\n%s\n```\n", trim (Fortune ());
$msg->replyMd ($reply); $msg->replyMd ($reply);
@@ -202,15 +238,26 @@ sub Command {
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'хэлп' || substr ($text, 1) eq 'хелп') { } elsif (substr ($text, 1) eq 'хэлп' || substr ($text, 1) eq 'halp') {
$reply = 'HALP!!!11'; $reply = 'HALP!!!11';
} elsif (substr ($text, 1) eq 'kde' || substr ($text, 1) eq 'кде') {
my @phrases = (
'Нет, я не буду поднимать вам плазму.',
'Повторяйте эту мантру по утрам не менее 5 раз: "Плазма не падает." И, возможно, она перестанет у вас падать.',
'Плазма не падает, она просто выходит отдохнуть.',
'Плазма это не агрегатное состояние, это суперпозиция. Во время работы она находится сразу в жидком, мягком и тёплом состояниях.',
);
$reply = $phrases[irand ($#phrases + 1)];
} elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') { } elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') {
$reply = << "MYHELP"; $reply = << "MYHELP";
``` ```
${csign}help | ${csign}помощь - список команд ${csign}help | ${csign}помощь - список команд
${csign}anek | ${csign}анек | ${csign}анекдот - рандомный анекдот с anekdot.ru
${csign}buni - рандомный стрип hapi buni ${csign}buni - рандомный стрип hapi buni
${csign}bunny | ${csign}rabbit | ${csign}кролик - кролик ${csign}bunny | ${csign}rabbit | ${csign}кролик - кролик
${csign}cat | ${csign}кис - кошечка ${csign}cat | ${csign}кис - кошечка
${csign}coin | ${csign}монетка - подбросить монетку - орёл или решка?
${csign}dig | ${csign}копать - заняться археологией ${csign}dig | ${csign}копать - заняться археологией
${csign}drink | ${csign}праздник - какой сегодня праздник? ${csign}drink | ${csign}праздник - какой сегодня праздник?
${csign}fish | ${csign}рыба | ${csign}рыбка - порыбачить ${csign}fish | ${csign}рыба | ${csign}рыбка - порыбачить
@@ -224,10 +271,16 @@ ${csign}horse | ${csign}лошадка - лошадка
${csign}lat | ${csign}лат - сгенерить фразу из крылатых латинских выражений ${csign}lat | ${csign}лат - сгенерить фразу из крылатых латинских выражений
${csign}monkeyuser - рандомный стрип MonkeyUser ${csign}monkeyuser - рандомный стрип MonkeyUser
${csign}owl | ${csign}сова - сова ${csign}owl | ${csign}сова - сова
${csign}proverb | ${csign}пословица - рандомная русская пословица
${csign}ping | ${csign}пинг - попинговать бота ${csign}ping | ${csign}пинг - попинговать бота
${csign}roll | ${csign}dice | ${csign}кости - бросить кости
${csign}snail | ${csign}улитка - улитка ${csign}snail | ${csign}улитка - улитка
${csign}ver | ${csign}version | ${csign}версия - что-то про версию ПО ${csign}ver | ${csign}version | ${csign}версия - что-то про версию ПО
${csign}w город | ${csign}п город - погода в указанном городе ${csign}w город | ${csign}п город - погода в указанном городе
${csign}weather город - погода в указанном городе
${csign}погода город - погода в указанном городе
${csign}погодка город - погода в указанном городе
${csign}погадка город - погода в указанном городе
${csign}xkcd - рандомный стрип с сайта xkcd.ru ${csign}xkcd - рандомный стрип с сайта xkcd.ru
${csign}karma фраза | ${csign}карма фраза - посмотреть карму фразы ${csign}karma фраза | ${csign}карма фраза - посмотреть карму фразы
фраза-- | фраза++ - убавить или добавить карму фразе фраза-- | фраза++ - убавить или добавить карму фразе

View File

@@ -206,6 +206,11 @@ sub PluginEnabled (@) {
my $chatid = shift; my $chatid = shift;
my $plugin = shift; my $plugin = shift;
# seems that we have point to return always true if chat is private
if ($chatid > 0) {
return 1;
}
my $cache = CHI->new ( my $cache = CHI->new (
driver => 'BerkeleyDB', driver => 'BerkeleyDB',
root_dir => $cachedir, root_dir => $cachedir,

88
lib/BotLib/Anek.pm Normal file
View File

@@ -0,0 +1,88 @@
package BotLib::Anek;
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Encode;
use HTML::TokeParser;
use JSON::XS;
use Log::Any qw ($log);
use Mojo::UserAgent;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Anek);
sub Anek {
my $r;
my $ret = 'Все рассказчики анекдотов отдыхают';
my $got_anek = 0;
for (1..3) {
for (1..3) {
my $ua = Mojo::UserAgent->new->connect_timeout (3);
$ua->max_redirects(3);
$r = $ua->get ('https://www.anekdot.ru/rss/randomu.html')->result;
if ($r->is_success) {
last;
}
sleep 2;
}
if ($r->is_success) {
my $json;
my $response_text = decode ('UTF-8', $r->body);
my @text = split /\n/, $response_text;
while (my $str = pop @text) {
if ($str =~ /^var anekdot_texts \= JSON/) {
$str = (split /JSON\.parse\(\'/, $str, 2)[1];
if (defined $str && length ($str) > 10) {
$json = (split /\';\)/, $str, 2)[0];
last;
}
}
}
if (defined $json && length ($json) > 10) {
$json =~ s/\\"/"/g;
$json =~ s/\\\\"/\\"/g;
$json = substr $json, 0, -3;
my $anek = eval { ${JSON::XS->new->relaxed->decode ($json)}[0] };
if (defined $anek) {
my @anek = split /<br>/, $anek;
$ret = join "\n", @anek;
if (length ($ret) > 1) {
$got_anek = 1;
}
} else {
$log->warn (sprintf '[WARN] anekdot.ru server returns incorrect json, full response text message: %s', $response_text);
}
} else {
$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $r->body);
}
} else {
$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
}
if ($got_anek) {
last;
}
}
return $ret;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

View File

@@ -90,7 +90,7 @@ sub Dig {
} }
my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)]; my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)];
$phrase .= "Вам кажется что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n"; $phrase .= "Вам кажется, что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n";
my $artifact = getRandomArtifact(); my $artifact = getRandomArtifact();
if ($success_probability <= 25) { if ($success_probability <= 25) {

View File

@@ -158,7 +158,7 @@ sub Obutts {
return $ret; return $ret;
} }
# It works but results are not particulary relevant, partially. about 20-30% miss # It works but results are not particularly relevant, partially. about 20-30% miss
# So i prefer to use flickr rabbits selection :) # So i prefer to use flickr rabbits selection :)
sub rabbit_imgur { sub rabbit_imgur {
my @terms = ( my @terms = (

View File

@@ -76,7 +76,7 @@ sub Imgur {
$refresh_url => form { $refresh_url => form {
refresh_token => $imgur_refresh_token, refresh_token => $imgur_refresh_token,
client_id => $imgur_client_id, client_id => $imgur_client_id,
clinent_secret => $imgur_client_secret, client_secret => $imgur_client_secret,
grant_type => 'refresh_token', grant_type => 'refresh_token',
} }
); );

88
lib/BotLib/Proverb.pm Normal file
View File

@@ -0,0 +1,88 @@
package BotLib::Proverb;
# Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter.
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 Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use SQLite_File;
use BotLib::Conf qw (LoadConf);
use BotLib::Util qw (trim);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Seed Proverb);
my $c = LoadConf ();
my $dir = $c->{proverb}->{dir};
my $srcdir = $c->{proverb}->{srcdir};
sub Seed () {
unless (-d $dir) {
make_path ($dir) || croak "Unable to create $dir: $OS_ERROR";
}
my $backingfile = sprintf '%s/proverb.sqlite', $dir;
if (-f $backingfile) {
unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR";
}
tie my @proverb, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR";
opendir (my $srcdirhandle, $srcdir) || croak "Unable to open $srcdir: $OS_ERROR";
while (my $proverbfile = readdir ($srcdirhandle)) {
my $srcfile = sprintf '%s/%s', $srcdir, $proverbfile;
unless (-f $srcfile) {
next;
}
if ($proverbfile =~ m/^\.+$/) {
next;
}
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR";
while (readline $fh) {
chomp;
my $str = trim ($_);
if ($str ne '') {
push @proverb, $str;
}
}
close $fh; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
}
closedir $srcdirhandle;
untie @proverb;
return;
}
# just return answer
sub Proverb () {
my $backingfile = sprintf '%s/proverb.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do {
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
return '';
};
my $phrase = $array[irand ($#array + 1)];
# decode?
utf8::decode $phrase;
untie @array;
return $phrase;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4:

View File

@@ -30,6 +30,15 @@ sub Weather {
return 'Длинновато для названия города.' if (length ($city) > 80); return 'Длинновато для названия города.' if (length ($city) > 80);
$city = ucfirst $city; $city = ucfirst $city;
if ($city eq 'Мск' || $city eq 'Default' || $city eq 'Dc' || $city eq 'Msk' || $city eq 'Dc-universe') {
$city = 'Москва';
} elsif ($city eq 'Спб' || $city eq 'Spb') {
$city = 'Санкт-Петербург';
} elsif ($city eq 'Ект' || $city eq 'Ебург' || $city eq 'Ёбург' || $city eq 'Екат' || $city eq 'Ekt' || $city eq 'Eburg' || $city eq 'Ekat') {
$city = 'Екатеринбург';
}
my $w = __weather ($city); my $w = __weather ($city);
my $reply; my $reply;

View File

@@ -458,6 +458,9 @@ sub sendChatAction {
elsif ($args->{action} eq 'upload_video_note') { elsif ($args->{action} eq 'upload_video_note') {
$send_args->{action} = 'upload_video_note'; $send_args->{action} = 'upload_video_note';
} }
elsif ($args->{action} eq 'choose_sticker') {
$send_args->{action} = 'choose_sticker';
}
else { else {
$send_args->{action} = 'typing'; $send_args->{action} = 'typing';
} }

View File

@@ -5,6 +5,7 @@ use Mojo::Base -base;
use List::Util qw/any/; use List::Util qw/any/;
use Carp qw/croak cluck/; use Carp qw/croak cluck/;
use Data::Dumper; use Data::Dumper;
use JSON::PP ();
$Teapot::Bot::Object::Base::VERSION = '0.022'; $Teapot::Bot::Object::Base::VERSION = '0.022';

View File

@@ -17,6 +17,9 @@ has 'first_name'; # Optional.
has 'last_name'; # Optional. has 'last_name'; # Optional.
has 'photo'; # Teapot::Bot::Object::ChatPhoto. Optional. Returned only in getChat. has 'photo'; # Teapot::Bot::Object::ChatPhoto. Optional. Returned only in getChat.
has 'bio'; # Optional. Bio of the other party in a private chat. Returned only in getChat. has 'bio'; # Optional. Bio of the other party in a private chat. Returned only in getChat.
has 'has_private_forwards'; # Optional. True, if privacy settings of the other party in the private chat allows to
# use tg://user?id=<user_id> links only in chats with the user.
# Returned only in getChat.
has 'description'; # Optional. Returned only in getChat. has 'description'; # Optional. Returned only in getChat.
has 'invite_link'; # Optional. Returned only in getChat. has 'invite_link'; # Optional. Returned only in getChat.
has 'pinned_message'; # Teapot::Bot::Object::Message has 'pinned_message'; # Teapot::Bot::Object::Message
@@ -25,6 +28,8 @@ has 'permissions'; # Teapot::Bot::Object::ChatPermissions. Optional
has 'slow_mode_delay'; # Optional. Returned only in getChat. has 'slow_mode_delay'; # Optional. Returned only in getChat.
has 'message_auto_delete_time'; # Optional. The time after which all messages sent to the chat will be automatically has 'message_auto_delete_time'; # Optional. The time after which all messages sent to the chat will be automatically
# deleted; in seconds. Returned only in getChat. # deleted; in seconds. Returned only in getChat.
has 'has_protected_content'; # Optional. True, if messages from the chat can't be forwarded to other chats.
# Returned only in getChat.
has 'sticker_set_name'; # Optional. Returned only in getChat. has 'sticker_set_name'; # Optional. Returned only in getChat.
has 'can_set_sticker_set'; # Optional. Returned only in getChat. has 'can_set_sticker_set'; # Optional. Returned only in getChat.
has 'linked_chat_id'; # Optional. greater than 32 bits, smaller than 52 bits has 'linked_chat_id'; # Optional. greater than 32 bits, smaller than 52 bits
@@ -32,8 +37,9 @@ has 'location'; # Optional. Returned only in getChat.
sub fields { sub fields {
return { return {
'scalar' => [qw/id type title username first_name last_name bio description 'scalar' => [qw/id type title username first_name last_name bio
invite_link slow_mode_delay message_auto_delete_time has_private_forwards description invite_link slow_mode_delay
message_auto_delete_time has_protected_content
sticker_set_name can_set_sticker_set linked_chat_id/], sticker_set_name can_set_sticker_set linked_chat_id/],
'Teapot::Bot::Object::ChatPhoto' => [qw/photo/], 'Teapot::Bot::Object::ChatPhoto' => [qw/photo/],
'Teapot::Bot::Object::Message' => [qw/pinned_message/], 'Teapot::Bot::Object::Message' => [qw/pinned_message/],

View File

@@ -8,15 +8,19 @@ $Teapot::Bot::Object::ChatInviteLink::VERSION = '0.022';
has 'invite_link'; has 'invite_link';
has 'creator'; has 'creator';
has 'creates_join_request';
has 'is_primary'; has 'is_primary';
has 'is_revoked'; has 'is_revoked';
has 'name';
has 'expire_date'; # Optional. Point in time (Unix timestamp) when the link will expire or has been expired has 'expire_date'; # Optional. Point in time (Unix timestamp) when the link will expire or has been expired
has 'member_limit'; # Optional. Maximum number of users that can be members of the chat simultaneously after joining has 'member_limit'; # Optional. Maximum number of users that can be members of the chat simultaneously after joining
# the chat via this invite link; 1-99999 # the chat via this invite link; 1-99999
has 'pending_join_request_count';
sub fields { sub fields {
return { return {
'scalar' => [qw/invite_link is_primary is_revoked expire_date expire_date member_limit/], 'scalar' => [qw/invite_link creates_join_request is_primary is_revoked name expire_date
member_limit pending_join_request_count/],
'Teapot::Bot::Object::User' => [qw/creator/], 'Teapot::Bot::Object::User' => [qw/creator/],
}; };
} }

View File

@@ -83,7 +83,7 @@ sub canDeleteMessage {
my $chatobj = $self->getChat ({ 'chat_id' => $chatid }); my $chatobj = $self->getChat ({ 'chat_id' => $chatid });
# on api error, keep silence # on api error, keep silence
unless ($chatobj) { if ($chatobj == 0 || $chatobj->{error}) {
cluck "Unable to get chat info for $chatid from telegram API"; cluck "Unable to get chat info for $chatid from telegram API";
return 0; return 0;
} }
@@ -91,7 +91,7 @@ sub canDeleteMessage {
my $myObj = $self->getMe (); my $myObj = $self->getMe ();
# on api error, keep silence # on api error, keep silence
unless ($chatobj) { if ($myObj == 0 || $myObj->{error}) {
cluck "Unable to get chat info for $chatid from telegram API"; cluck "Unable to get chat info for $chatid from telegram API";
return 0; return 0;
} }
@@ -100,7 +100,7 @@ sub canDeleteMessage {
my $me = $self->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid }); my $me = $self->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
# on api error, keep silence # on api error, keep silence
unless ($me) { if ($me == 0 || $me->{error}) {
cluck 'Unable to get chat info for bot itself from telegram API'; cluck 'Unable to get chat info for bot itself from telegram API';
return 0; return 0;
} }

View File

@@ -39,26 +39,26 @@ sub canTalk {
my $chatobj = $self->_brain->getChat ({ 'chat_id' => $chatid }); my $chatobj = $self->_brain->getChat ({ 'chat_id' => $chatid });
# on api error, keep silence # on api error, keep silence
unless ($chatobj) { if ($chatobj == 0 || $chatobj->{error}) {
carp "Unable to get chat info for $chatid from telegram API"; carp "Unable to get chat info for $chatid from telegram API";
return 0; return $can_talk;
} }
my $myObj = $self->_brain->getMe (); my $myObj = $self->_brain->getMe ();
# on api error, keep silence # on api error, keep silence
unless ($chatobj) { if ($myObj == 0 || $myObj->{error}) {
carp "Unable to get chat info for $chatid from telegram API"; carp "Unable to get chat info for $chatid from telegram API";
return 0; return $can_talk;
} }
my $myid = $myObj->id; my $myid = $myObj->id;
my $me = $self->_brain->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid }); my $me = $self->_brain->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
# on api error, keep silence # on api error, keep silence
unless ($me) { if ($me == 0 || $me->{error}) {
carp 'Unable to get chat info for bot itself from telegram API'; carp 'Unable to get chat info for bot itself from telegram API';
return 0; return $can_talk;
} }
if ($me->{'status'} eq 'administrator') { if ($me->{'status'} eq 'administrator') {

View File

@@ -52,9 +52,11 @@ has 'forward_from_message_id';
has 'forward_signature'; has 'forward_signature';
has 'forward_sender_name'; has 'forward_sender_name';
has 'forward_date'; has 'forward_date';
has 'is_automatic_forward';
has 'reply_to_message'; # Message has 'reply_to_message'; # Message
has 'via_bot'; # User has 'via_bot'; # User
has 'edit_date'; has 'edit_date';
has 'has_protected_content';
has 'media_group_id'; has 'media_group_id';
has 'author_signature'; has 'author_signature';
has 'text'; has 'text';
@@ -102,8 +104,8 @@ sub fields {
return { return {
'scalar' => [qw/message_id date forward_from_message_id 'scalar' => [qw/message_id date forward_from_message_id
forward_signature forward_sender_name forward_signature forward_sender_name
forward_date edit_date media_group_id forward_date is_automatic_forward edit_date has_protected_content
author_signature text caption media_group_id author_signature text caption
new_chat_title delete_chat_photo new_chat_title delete_chat_photo
group_chat_created supergroup_chat_created group_chat_created supergroup_chat_created
channel_chat_created migrate_to_chat_id channel_chat_created migrate_to_chat_id
@@ -155,7 +157,7 @@ sub reply {
my $chatid = $self->chat->id; my $chatid = $self->chat->id;
if (Teapot::Bot::Object::ChatPermissions::canTalk($self, $chatid)) { if (Teapot::Bot::Object::ChatPermissions->canTalk($self, $chatid)) {
return $self->_brain->sendMessage({chat_id => $chatid, text => $text}); return $self->_brain->sendMessage({chat_id => $chatid, text => $text});
} }
@@ -168,7 +170,7 @@ sub replyMd {
my $chatid = $self->chat->id; my $chatid = $self->chat->id;
if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) { if (Teapot::Bot::Object::ChatPermissions->canTalk ($self, $chatid)) {
my $send_args; my $send_args;
$send_args->{text} = $text; $send_args->{text} = $text;
$send_args->{parse_mode} = 'Markdown'; $send_args->{parse_mode} = 'Markdown';
@@ -185,7 +187,7 @@ sub typing {
my $chatid = $self->chat->id; my $chatid = $self->chat->id;
if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) { if (Teapot::Bot::Object::ChatPermissions->canTalk ($self, $chatid)) {
return $self->_brain->sendChatAction({chat_id => $chatid}); return $self->_brain->sendChatAction({chat_id => $chatid});
} }

View File

@@ -5,19 +5,19 @@ use 5.018;
use strict; use strict;
use warnings; use warnings;
use utf8; use utf8;
use Data::Dumper;
use open qw (:std :utf8); use open qw (:std :utf8);
use English qw ( -no_match_vars ); use English qw ( -no_match_vars );
use Carp qw (cluck carp); use Carp qw (cluck carp);
use File::Path qw (make_path); use File::Path qw (make_path);
use Hailo; use Hailo;
use Log::Any qw($log); use Log::Any qw ($log);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use Mojo::Base 'Teapot::Bot::Brain'; use Mojo::Base 'Teapot::Bot::Brain';
use BotLib::Admin qw (FortuneToggleList); use BotLib::Admin qw (FortuneToggleList);
use BotLib qw (RandomCommonPhrase Command Highlight BotSleep IsCensored); use BotLib qw (RandomCommonPhrase Command Highlight BotSleep IsCensored);
use BotLib::Conf qw (LoadConf); use BotLib::Conf qw (LoadConf);
use BotLib::Fortune qw (Fortune); use BotLib::Fortune qw (Fortune);
use BotLib::Image qw (Oboobs Obutts);
use BotLib::Karma qw (KarmaSet); use BotLib::Karma qw (KarmaSet);
use BotLib::Util qw (trim fmatch); use BotLib::Util qw (trim fmatch);
@@ -115,21 +115,33 @@ sub __on_msg {
# Newcommer event, greet our new member and suggest to introduce themself. # Newcommer event, greet our new member and suggest to introduce themself.
if ($msg->can ('new_chat_members') && defined ($msg->new_chat_members)) { if ($msg->can ('new_chat_members') && defined ($msg->new_chat_members)) {
my @members; my @members;
my @introduce = (
'Дратути',
'Дарована',
'Доброе утро, день или вечер',
'Добро пожаловать в наше скромное коммунити',
'Наше вам с кисточкой тут, на канальчике',
);
foreach my $member (@{$msg->new_chat_members}) { foreach my $member (@{$msg->new_chat_members}) {
my $member_str = ''; my $member_str = '';
if ($member->can ('first_name') && defined ($member->first_name)) { # 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; $member_str .= $member->first_name;
if ($member->can ('last_name') && defined ($member->last_name)) { if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
$member_str .= ' ' . $member->last_name; $member_str .= ' ' . $member->last_name;
} }
} else { } else {
if ($member->can ('last_name') && defined ($member->last_name)) { if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
$member_str .= ' ' . $member->last_name; $member_str .= ' ' . $member->last_name;
} else { # username must be uniq and should contain only english letters and numbers, so...
} elsif ($member->can ('username') && defined ($member->username)) {
$member_str .= '@' . $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;
} }
} }
@@ -138,9 +150,9 @@ sub __on_msg {
if ($#members > 1) { if ($#members > 1) {
my $lastone = pop @members; my $lastone = pop @members;
$phrase = sprintf 'Дратути, %s и %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', join (', ', @members), $lastone; $phrase = sprintf '%s, %s и %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $introduce[irand ($#introduce + 1)], join (', ', @members), $lastone;
} else { } else {
$phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0]; $phrase = sprintf '%s, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $introduce[irand ($#introduce + 1)], $members[0];
} }
BotSleep $msg; BotSleep $msg;
@@ -189,23 +201,41 @@ sub __on_msg {
} else { } else {
$just_message_in_chat = 1; $just_message_in_chat = 1;
} }
} else {
$just_message_in_chat = 1;
} }
if ($just_message_in_chat) { if ($just_message_in_chat) {
my $str = $hailo->{$msg->chat->id}->learn_reply ($text); if ($text =~ /^ *кто +все +эти +люди *\?$/ui) {
$reply = 'Какие "люди"? Мы здесь вдвоём, только ты и я.';
} elsif ($text =~ /^ *кто +я *\?$/ui) {
$reply = 'Где?';
} elsif ($text =~ /^ *кто +(здесь|тут) *\?$/ui) {
$reply = 'Ты да я, да мы с тобой.';
} elsif ($text =~ /покажи +(сиськи|сиси|титьки) *$/ui) {
$reply = Oboobs ();
} elsif ($text =~ /show +(titts|tities|boobs) *$/i) {
$reply = Oboobs ();
} elsif ($text =~ /покажи +(попку|попу) *$/ui) {
$reply = Obutts ();
} elsif ($text =~ /show +(ass|butt|butty) *$/i) {
$reply = Obutts ();
} else {
my $str = $hailo->{$msg->chat->id}->learn_reply ($text);
if (defined ($str) && $str ne '') { if (defined ($str) && $str ne '') {
$reply = $str; $reply = $str;
$phrase = trim $text; $phrase = trim $text;
while ($phrase =~ /[\.|\,|\?|\!]$/) { while ($phrase =~ /[\.|\,|\?|\!]$/) {
chop $phrase; chop $phrase;
} }
$phrase = lc $phrase; $phrase = lc $phrase;
if (fmatch (lc ($reply), $phrase)) { if (fmatch (lc ($reply), $phrase)) {
$reply = RandomCommonPhrase (); $reply = RandomCommonPhrase ();
}
} }
} }
} }
@@ -244,20 +274,31 @@ sub __on_msg {
$log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi)); $log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi));
# do not answer back if someone quote our new member greet # do not answer back if someone quote our new member greet
if ((substr ($msg->reply_to_message->text, 0, 9) eq 'Дратути, ') && if (substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.') {
(substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.')) { my @hello = (
return; 'Дратути, ',
} else { 'Дарована, ',
# remove our name from users reply, just in case 'Доброе утро, день или вечер, ',
my $pat1 = quotemeta ('@' . $myusername); 'Добро пожаловать в наше скромное коммунити, ',
my $pat2 = quotemeta $myfullname; 'Наше вам с кисточкой тут, на канальчике, ',
$phrase = $text; );
$phrase =~ s/$pat1//g;
$phrase =~ s/$pat2//g; foreach my $hi (@hello) {
if (substr ($msg->reply_to_message->text, 0, length $hi) eq $hi) {
return;
}
}
}
# remove our name from users reply, just in case
my $pat1 = quotemeta ('@' . $myusername);
my $pat2 = quotemeta $myfullname;
$phrase = $text;
$phrase =~ s/$pat1//g;
$phrase =~ s/$pat2//g;
# figure out reply :) # figure out reply :)
$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase) if (length ($phrase) > 3); $reply = $hailo->{$msg->chat->id}->learn_reply ($phrase) if (length ($phrase) > 3);
}
# simple commands # simple commands
} elsif (substr ($text, 0, 1) eq $csign) { } elsif (substr ($text, 0, 1) eq $csign) {
$reply = Command ($self, $msg, $text, $chatid); $reply = Command ($self, $msg, $text, $chatid);
@@ -277,8 +318,12 @@ sub __on_msg {
if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){ if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){
$phrase = $1; $phrase = $1;
if ($phrase =~ /^кто +все +эти +люди *\?$/i) { if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
$reply = 'Кто здесь?'; $reply = 'Кто здесь?';
} elsif ($phrase =~ /^ *кто +я *?$/ui){
$reply = 'Где?';
} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
} else { } else {
$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase); $reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
} }
@@ -286,8 +331,12 @@ sub __on_msg {
} elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) { } elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) {
$phrase = $text; $phrase = $text;
if ($phrase =~ /^кто +все +эти +люди *\?$/i) { if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
$reply = 'Кто здесь?'; $reply = 'Кто здесь?';
} elsif ($phrase =~ /^ *кто +я *?$/ui){
$reply = 'Где?';
} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
} else { } else {
$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase); $reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
} }
@@ -295,8 +344,12 @@ sub __on_msg {
} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) { } elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
$phrase = $text; $phrase = $text;
if ($phrase =~ /^кто +все +эти +люди *\?$/i) { if ($phrase =~ /^ *кто +все +эти +люди *\?$/ui) {
$reply = 'Кто здесь?'; $reply = 'Кто здесь?';
} elsif ($phrase =~ /^ *кто +я *?$/ui){
$reply = 'Где?';
} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
} else { } else {
$reply = $hailo->{$msg->chat->id}->learn_reply ($phrase); $reply = $hailo->{$msg->chat->id}->learn_reply ($phrase);
} }
@@ -312,8 +365,12 @@ sub __on_msg {
} }
# just message in chat # just message in chat
} else { } else {
if ($text =~ /^кто +все +эти +люди *\?$/i) { if ($text =~ /^ *кто +все +эти +люди *\?$/ui) {
$reply = 'Кто здесь?'; $reply = 'Кто здесь?';
} elsif ($phrase =~ /^ *кто +я *?$/ui){
$reply = 'Где?';
} elsif ($phrase =~ /^ *кто +(здесь|тут) *\?$/ui) {
$reply = 'Здесь все: Никита, Стас, Гена, Турбо и Дюша Метёлкин.';
} else { } else {
$hailo->{$msg->chat->id}->learn ($text); $hailo->{$msg->chat->id}->learn ($text);
} }