Compare commits
20 Commits
bdcd3b56e5
...
update_tea
| Author | SHA1 | Date | |
|---|---|---|---|
|
0aae36d534 | ||
|
|
e7ef39366b | ||
|
|
f7634a26d1 | ||
|
|
57dee8b168 | ||
|
|
5d17018490 | ||
|
|
b8fb89358e | ||
|
|
c6ce5b1421 | ||
|
|
36208a35d5 | ||
|
|
23471ee185 | ||
|
|
3a39cf8513 | ||
|
|
bca6ee8512 | ||
|
|
2af166e3e6 | ||
|
|
6735d6217a | ||
|
|
3eb3e2126d | ||
|
|
c58a571da5 | ||
|
|
efea02972c | ||
|
|
d55d35f877 | ||
|
|
c8a766881e | ||
|
|
f669186787 | ||
|
|
1991edc803 |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -9,4 +9,5 @@ data/friday/**
|
||||
data/karma/**
|
||||
data/telegrambot-brains/**
|
||||
data/lat/**
|
||||
data/image/**
|
||||
vendor_perl/**
|
||||
|
||||
84
README.md
84
README.md
@@ -5,33 +5,99 @@
|
||||
It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation
|
||||
generator.
|
||||
|
||||
I have to fork [Telegram::Bot][1] and add some of new methods that are already
|
||||
appear in [Telegram API][3], but author seems to abandon lib. Also, I decide to
|
||||
rename it to avoid collision in the future, now it is Teapot::Bot and is bundled
|
||||
with bot. When lib become mature enough, maybe I release it separately.
|
||||
I have to fork [Telegram::Bot][1] and update it according to features appeared
|
||||
in [Telegram Bot API v5][3]. Also, I decide to rename it to avoid collision in
|
||||
the future, now it is Teapot::Bot and is bundled with bot. When lib becomes
|
||||
mature enough, maybe I release it separately.
|
||||
|
||||
Bot config located in **data/config.json**, sample config provided as
|
||||
**data/sample_config.json**.
|
||||
|
||||
Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon.
|
||||
Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon (double fork()
|
||||
and detaches stdio).
|
||||
|
||||
## Installation
|
||||
|
||||
In order to run this application, you need to "bootstrap" it - download and build
|
||||
all required dependencies and libraries.
|
||||
|
||||
You'll need "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.
|
||||
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:
|
||||
|
||||
```bash
|
||||
|
||||
bash bootstrap.sh
|
||||
|
||||
```
|
||||
|
||||
and all libraries should be downloaded, built, tested and installed.
|
||||
|
||||
## Running
|
||||
|
||||
This bot does not [ultilize][4] webhooks, so in order to run it only well
|
||||
internet connection is requied, no public-available ip address is needed.
|
||||
|
||||
### Additional Settings to be performed in order to run bot as it designed
|
||||
|
||||
There are some "plugins" that requires registration on thrird party services
|
||||
and API keys and secrets in order to work.
|
||||
|
||||
#### OpenWeatherMap
|
||||
|
||||
You should [register][5], [login][6] and [create][7] api key. Free plan have
|
||||
all required features to run this "plugin".
|
||||
|
||||
Once key is created you should put it in **config.json** under openweathermap
|
||||
section as appid. Thats it.
|
||||
|
||||
It is still impossible to disable this plugin, but "I'm working on it".
|
||||
|
||||
#### Imgur
|
||||
|
||||
This plugin "just exists" and is actually used nowhere around the code.
|
||||
Anyway, to make use of it besides registering apropriate handler in code, you
|
||||
should sign in imgur and get access token.
|
||||
|
||||
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]
|
||||
of your app. Then you should authorise your app according to [this][10] manual. Or
|
||||
[this][11] one.
|
||||
|
||||
#### Flickr
|
||||
|
||||
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
|
||||
and secrets from flickr api.
|
||||
|
||||
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.
|
||||
(It is required in order to properly get "verfier" parameter later).
|
||||
|
||||
Put your [app key and secret][13] to **config.json**. Ensure that "verifier" parameter
|
||||
in Flickr-related part of config either absent or commented out.
|
||||
|
||||
Run **bin/flickr_init.pl** first time and follow on screen instuctions - copy and
|
||||
paste given link to browser login to flickr account adn yo'll be redirected to
|
||||
example.com. Check address bar in browser to get so-called "verifier", put it in
|
||||
**config.json**. Then run **bin/flickr_init.pl** again to store API access token in db
|
||||
under data/image directory (in default config). You're done.
|
||||
|
||||
[1]: https://metacpan.org/pod/Telegram::Bot
|
||||
[2]: https://metacpan.org/pod/Hailo
|
||||
[3]: https://core.telegram.org/bots/api
|
||||
[3]: https://core.telegram.org/bots/api
|
||||
[4]: https://core.telegram.org/bots/api#getting-updates
|
||||
[5]: https://home.openweathermap.org/users/sign_up
|
||||
[6]: https://home.openweathermap.org/users/sign_in
|
||||
[7]: https://home.openweathermap.org/api_keys
|
||||
[8]: https://imgur.com/signin
|
||||
[9]: https://api.imgur.com/oauth2/addclient
|
||||
[10]: https://apidocs.imgur.com/#authorization-and-oauth
|
||||
[11]: https://identity.flickr.com/login
|
||||
[12]: https://www.flickr.com/services/apps/create/apply/
|
||||
[13]: https://www.flickr.com/services/api/keys/
|
||||
|
||||
103
README_RU.md
Normal file
103
README_RU.md
Normal file
@@ -0,0 +1,103 @@
|
||||
# Aleesa-Telegram-bot - Болтливый бот для Telegram
|
||||
|
||||
## Что это такое
|
||||
|
||||
Это бот основанный на перловых модулях [Telegram::Bot][1] для работы в
|
||||
мессенджере Telegram и [Hailo][2] для генерации "умной" беседы.
|
||||
|
||||
Для корректной работы пришлось форкнуть [Telegram::Bot][1] чтобы обновить
|
||||
интерфейс API до [Telegram Bot API v5][3]. Для избежания неоднозначностей модуль
|
||||
пришлось переименовать и теперь он идёт в составе бота. Возможно, когда модуль
|
||||
отлежится и будет похож на стабильный, он стнет самостоятельным и поселится на
|
||||
metacpan.org
|
||||
|
||||
Конфиг бота должен лежать в **data/config.json**, пример конфига расположен в
|
||||
**data/sample_config.json**.
|
||||
|
||||
Бота можно запустить через **bin/aleesa-telegram-bot** и он взлетит как юниксовый
|
||||
демон (сделает двойной fork() и отцепится от stdio).
|
||||
|
||||
## Установка
|
||||
|
||||
Чтобы запустить приложение, его надо "забурстрапить" - загрузить и собрать все
|
||||
необходимые зависимости.
|
||||
|
||||
Понадобится 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 bootstrap.sh
|
||||
|
||||
```
|
||||
|
||||
и по идее всё что нужно будет выкачено, собрано и разложено куда надо.
|
||||
|
||||
## Запуск и работа
|
||||
|
||||
Бот не использует [вебхуки][4], поэтому ничего дополнительного, кроме хорошего
|
||||
подключения к интернету ему не нужно.
|
||||
|
||||
### Дополнительные настройки
|
||||
|
||||
Некоторые "плагины" требуют регистрации в сторонних сервисах (API keys, secrets
|
||||
итд), чтобы бот не сыпал ошибками в логи (возможно, в дальнейшем возможно будет
|
||||
отключить эти плагины).
|
||||
|
||||
#### OpenWeatherMap
|
||||
|
||||
Для работы погодного плагина надо [заргистрироваться][5], [залогиниться][6] и
|
||||
[создать][7] api key. Free plan предлагает всё необхдимое для работы "плагина".
|
||||
|
||||
Когда api key будет создан, его нужно вписать в **config.json** "секцию"
|
||||
openweathermap в качестве appid. На этом всё.
|
||||
|
||||
#### Imgur
|
||||
|
||||
Этот плагин "просто есть" и его на самом деле ничто и никто не использует. И в
|
||||
этой связи все настройки плагина можно оставить "как есть" в примере конфига.
|
||||
|
||||
Тем не менее, если есть большое желание, то можно [залогиниться][8] и
|
||||
[зарегистрировать][9] бота как приложение, а потом разрешить приложению
|
||||
пользоваться API-шкой, как описано в [этом][10] или [этом][11] мануале.
|
||||
|
||||
#### Flickr
|
||||
|
||||
Этот "плагин" действительно используется для добычи ссылок на картинки в разных
|
||||
"картиночных" командах бота.
|
||||
|
||||
Есть скрипт, который поможет с регистрацией приложения в api Flickr -
|
||||
**bin/flickr_init.pl** он достанет все нужные ключи и секреты к ним.
|
||||
|
||||
До запуска этого скрипта, бот должен быть забутстраплен через **`bootstrap.sh`**.
|
||||
|
||||
[Залогиньтесь][11] и создайте [app][12] in своём Flicker-овском аккаунте. Далее,
|
||||
*разлогиньтесь*, это нужно, чтобы потом проще было достать параметр verifier.
|
||||
|
||||
Запишите [app key и secret][13] в **config.json**. Удостоверьтесь, что параметр
|
||||
"verifier" в конфиге либо закоменчен либо отсутствует.
|
||||
|
||||
Запустите **bin/flickr_init.pl** и следуте предлагаемым инструкциям - в итоге
|
||||
будет дана ссылка, которую надо скопипастить в браузер и через один-два
|
||||
редиректа вы попадёте на example.com. Из адресной строки браузера надо
|
||||
скопировать параметр "verifier" и вписать его в **config.json**.
|
||||
|
||||
Чтобы сохранить в бд плагина API access token для нормальной работы "плагина",
|
||||
второй раз запустите **bin/flickr_init.pl**. На этом всё.
|
||||
|
||||
[1]: https://metacpan.org/pod/Telegram::Bot
|
||||
[2]: https://metacpan.org/pod/Hailo
|
||||
[3]: https://core.telegram.org/bots/api
|
||||
[4]: https://core.telegram.org/bots/api#getting-updates
|
||||
[5]: https://home.openweathermap.org/users/sign_up
|
||||
[6]: https://home.openweathermap.org/users/sign_in
|
||||
[7]: https://home.openweathermap.org/api_keys
|
||||
[8]: https://imgur.com/signin
|
||||
[9]: https://api.imgur.com/oauth2/addclient
|
||||
[10]: https://apidocs.imgur.com/#authorization-and-oauth
|
||||
[11]: https://identity.flickr.com/login
|
||||
[12]: https://www.flickr.com/services/apps/create/apply/
|
||||
[13]: https://www.flickr.com/services/api/keys/
|
||||
32
bin/flickr.pl
Normal file
32
bin/flickr.pl
Normal file
@@ -0,0 +1,32 @@
|
||||
#!/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 flickr qw (flickr_by_tags);
|
||||
|
||||
my $url = flickr_by_tags ('bird,owl');
|
||||
|
||||
if ($url) {
|
||||
say $url; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
exit 0;
|
||||
} else {
|
||||
exit 1;
|
||||
}
|
||||
29
bin/flickr_init.pl
Normal file
29
bin/flickr_init.pl
Normal file
@@ -0,0 +1,29 @@
|
||||
#!/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 flickr qw (flickr_init);
|
||||
|
||||
if (flickr_init ()) {
|
||||
exit 0;
|
||||
} else {
|
||||
exit 1;
|
||||
}
|
||||
29
bin/flickr_test.pl
Normal file
29
bin/flickr_test.pl
Normal file
@@ -0,0 +1,29 @@
|
||||
#!/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 flickr qw (flickr_test_login);
|
||||
|
||||
if (flickr_test_login ()) {
|
||||
exit 0;
|
||||
} else {
|
||||
exit 1;
|
||||
}
|
||||
8
cpanfile
8
cpanfile
@@ -1,14 +1,18 @@
|
||||
requires 'Carp';
|
||||
requires 'CHI';
|
||||
requires 'CHI::Driver::BerkeleyDB';
|
||||
requires 'Cwd::utf8';
|
||||
requires 'DateTime';
|
||||
requires 'DB_File';
|
||||
requires 'SQLite_File';
|
||||
requires 'Digest::HMAC_SHA1';
|
||||
requires 'Digest::MD5';
|
||||
requires 'Data::Dumper';
|
||||
requires 'Digest::SHA';
|
||||
requires 'File::Basename';
|
||||
requires 'File::Path';
|
||||
requires 'Hailo';
|
||||
requires 'HTTP::Tiny';
|
||||
requires 'HTML::TokeParser';
|
||||
requires 'IO::Socket::SSL';
|
||||
requires 'JSON';
|
||||
requires 'JSON::XS';
|
||||
@@ -21,5 +25,7 @@ requires 'Math::Random::Secure';
|
||||
requires 'Mojo::Base';
|
||||
requires 'Mojo::IOLoop';
|
||||
requires 'Mojo::UserAgent';
|
||||
requires 'Mojo::UserAgent::Cached';
|
||||
requires 'Text::Fuzzy';
|
||||
requires 'URI::Encode::XS';
|
||||
requires 'URI::URL';
|
||||
|
||||
@@ -1,40 +1,65 @@
|
||||
{
|
||||
"user" : "nobody",
|
||||
"debug_log" : "/var/log/aleesa-telegram-bot/debug.log",
|
||||
"admin" : {
|
||||
# store per-channel (per-conversation) settings
|
||||
"dir" : "data/admin"
|
||||
},
|
||||
"image": {
|
||||
"dir" : "data/image",
|
||||
"imgur" : {
|
||||
"client-id" : "imgur api client id",
|
||||
"secret" : "secret for client id",
|
||||
"access_token" : "access token for querying imgur api",
|
||||
"refresh_token" : "token for refreshing access token"
|
||||
}
|
||||
},
|
||||
"friday" : {
|
||||
"dir" : "data/friday",
|
||||
"src" : "data/friday.txt"
|
||||
},
|
||||
|
||||
"fortune" : {
|
||||
"dir" : "data/fortune",
|
||||
"srcdir" : "data/fortune_src"
|
||||
},
|
||||
"telegrambot" : {
|
||||
"csign" : "!",
|
||||
"token" : "get_it_from_botfather",
|
||||
"braindir": "data/telegrambot-brains"
|
||||
|
||||
"friday" : {
|
||||
"dir" : "data/friday",
|
||||
"src" : "data/friday.txt"
|
||||
},
|
||||
"openweathermap" : {
|
||||
"appid": "get_it_on_openweathermap.org",
|
||||
"cachedir" : "data/cache"
|
||||
|
||||
"image": {
|
||||
"dir" : "data/image",
|
||||
"imgur" : {
|
||||
# see README.md about these settings - auth'ed search settings
|
||||
"client-id" : "imgur api client id",
|
||||
"secret" : "secret for client id",
|
||||
"access_token" : "access token for querying imgur api",
|
||||
"refresh_token" : "token for refreshing access token"
|
||||
},
|
||||
"flickr" : {
|
||||
# see README.md about these settings - auth'ed search settings
|
||||
"consumer_key" : "md5-like_hash",
|
||||
"consumer_secret" : "some_hash-like_string",
|
||||
"verifier": "some_hash-like_string"
|
||||
}
|
||||
},
|
||||
|
||||
"karma": {
|
||||
"dir": "data/karma"
|
||||
},
|
||||
|
||||
"lat" : {
|
||||
"brain": "data/lat/lat.sqlite",
|
||||
"brain": "data/lat/brain.sqlite",
|
||||
"src": "data/lat.txt"
|
||||
},
|
||||
"karma" : {
|
||||
"dir": "data/karma"
|
||||
}
|
||||
|
||||
# required for debugging reasons, if commented out or not exist, no debug logging appears at all
|
||||
"log" : "/var/log/aleesa-telegram-bot/debug.log",
|
||||
|
||||
# openwatermap plugin
|
||||
"openweathermap" : {
|
||||
"appid" : "md5sum-like_string",
|
||||
# result cache, stores data for 4 hours
|
||||
"cachedir" : "data/cache",
|
||||
},
|
||||
|
||||
# stuff for telegram itself
|
||||
"telegrambot" : {
|
||||
# directory with per-conversation "brains"
|
||||
"braindir" : "data/telegrambot-brains",
|
||||
# prefix-sign for all commands. in many irc-bots (eggdrop/windrop) it is "." (dot), in sulci it was "!"
|
||||
# in telegram commands begin with "/" on the start of first (and only) line.
|
||||
"csign" : "!",
|
||||
"token" : "Long_string_given_by_@BotFather"
|
||||
},
|
||||
|
||||
# unprivileged user to run this bot from
|
||||
"user" : "unit",
|
||||
}
|
||||
|
||||
@@ -6,6 +6,7 @@ use Mojo::Base -base;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use English qw ( -no_match_vars );
|
||||
|
||||
use Mojo::IOLoop;
|
||||
use Mojo::UserAgent;
|
||||
@@ -76,7 +77,7 @@ sub think {
|
||||
$self->init();
|
||||
|
||||
$self->_add_getUpdates_handler;
|
||||
Mojo::IOLoop->start until Mojo::IOLoop->is_running;
|
||||
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
|
||||
return;
|
||||
}
|
||||
|
||||
@@ -131,6 +132,61 @@ sub getChatMember {
|
||||
}
|
||||
}
|
||||
|
||||
sub kickChatMember {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
|
||||
my $token = $self->token || croak 'No token supplied to kickChatMember?';
|
||||
my $send_args = {};
|
||||
|
||||
unless ($args->{chat_id}) {
|
||||
cluck 'No chat_id supplied to kickChatMember()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
unless ($args->{user_id}) {
|
||||
cluck 'No user_id supplied to kickChatMember()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
$send_args->{chat_id} = $args->{chat_id};
|
||||
$send_args->{user_id} = $args->{user_id};
|
||||
$send_args->{until_date} = $args->{until_date} if exists $args->{until_date};
|
||||
$send_args->{revoke_messages} = $args->{revoke_messages} if exists $args->{revoke_messages};
|
||||
|
||||
my $url = "https://api.telegram.org/bot${token}/kickChatMember";
|
||||
my $api_response = $self->_post_request($url, $send_args);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub unbanChatMember {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
|
||||
my $token = $self->token || croak 'No token supplied to unbanChatMember?';
|
||||
my $send_args = {};
|
||||
|
||||
unless ($args->{chat_id}) {
|
||||
cluck 'No chat_id supplied to unbanChatMember()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
unless ($args->{user_id}) {
|
||||
cluck 'No user_id supplied to unbanChatMember()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
$send_args->{chat_id} = $args->{chat_id};
|
||||
$send_args->{user_id} = $args->{user_id};
|
||||
$send_args->{only_if_banned} = $args->{only_if_banned} if exists $args->{only_if_banned};
|
||||
|
||||
my $url = "https://api.telegram.org/bot${token}/unbanChatMember";
|
||||
my $api_response = $self->_post_request($url, $send_args);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub getChat {
|
||||
my $self = shift;
|
||||
@@ -159,6 +215,28 @@ sub getChat {
|
||||
}
|
||||
|
||||
|
||||
sub leaveChat {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
|
||||
my $send_args = {};
|
||||
|
||||
unless ($args->{chat_id}) {
|
||||
cluck 'No chat_id supplied to getChat()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
$send_args->{chat_id} = $args->{chat_id};
|
||||
|
||||
my $token = $self->token || croak 'No token supplied to getChat()?';
|
||||
|
||||
my $url = "https://api.telegram.org/bot${token}/leaveChat";
|
||||
my $api_response = $self->_post_request($url, $send_args);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub sendMessage {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
@@ -384,6 +462,121 @@ sub sendChatAction {
|
||||
return;
|
||||
}
|
||||
|
||||
sub exportChatInviteLink {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
my $send_args = {};
|
||||
|
||||
my $token = $self->token || croak 'No token supplied to createChatInviteLink()?';
|
||||
|
||||
unless ($args->{chat_id}) {
|
||||
cluck 'No chat_id supplied in createChatInviteLink()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
$send_args->{chat_id} = $args->{chat_id};
|
||||
|
||||
my $url = "https://api.telegram.org/bot${token}/exportChatInviteLink";
|
||||
my $api_response = $self->_post_request($url);
|
||||
|
||||
if ($api_response) {
|
||||
return $api_response;
|
||||
}
|
||||
else {
|
||||
return {'error' => 1};
|
||||
}
|
||||
}
|
||||
|
||||
sub createChatInviteLink {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
my $send_args = {};
|
||||
|
||||
my $token = $self->token || croak 'No token supplied to createChatInviteLink()?';
|
||||
|
||||
unless ($args->{chat_id}) {
|
||||
cluck 'No chat_id supplied in createChatInviteLink()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
$send_args->{chat_id} = $args->{chat_id};
|
||||
$send_args->{expire_date} = $args->{expire_date} if exists $args->{expire_date};
|
||||
$send_args->{member_limit} = $args->{member_limit} if exists $args->{member_limit};
|
||||
|
||||
my $url = "https://api.telegram.org/bot${token}/createChatInviteLink";
|
||||
my $api_response = $self->_post_request($url);
|
||||
|
||||
if ($api_response) {
|
||||
return Teapot::Bot::Object::ChatInviteLink->create_from_hash($api_response, $self);
|
||||
}
|
||||
else {
|
||||
return {'error' => 1};
|
||||
}
|
||||
}
|
||||
|
||||
sub editChatInviteLink {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
my $send_args = {};
|
||||
|
||||
my $token = $self->token || croak 'No token supplied to editChatInviteLink()?';
|
||||
|
||||
unless ($args->{chat_id}) {
|
||||
cluck 'No chat_id supplied in editChatInviteLink()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
unless ($args->{invite_link}) {
|
||||
cluck 'No invite_link supplied in editChatInviteLink()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
$send_args->{chat_id} = $args->{chat_id};
|
||||
$send_args->{invite_link} = $args->{invite_link};
|
||||
$send_args->{expire_date} = $args->{expire_date} if exists $args->{expire_date};
|
||||
$send_args->{member_limit} = $args->{member_limit} if exists $args->{member_limit};
|
||||
|
||||
my $url = "https://api.telegram.org/bot${token}/editChatInviteLink";
|
||||
my $api_response = $self->_post_request($url);
|
||||
|
||||
if ($api_response) {
|
||||
return Teapot::Bot::Object::ChatInviteLink->create_from_hash($api_response, $self);
|
||||
}
|
||||
else {
|
||||
return {'error' => 1};
|
||||
}
|
||||
}
|
||||
|
||||
sub revokeChatInviteLink {
|
||||
my $self = shift;
|
||||
my $args = shift || {};
|
||||
my $send_args = {};
|
||||
|
||||
my $token = $self->token || croak 'No token supplied to revokeChatInviteLink()?';
|
||||
|
||||
unless ($args->{chat_id}) {
|
||||
cluck 'No chat_id supplied in revokeChatInviteLink()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
unless ($args->{invite_link}) {
|
||||
cluck 'No invite_link supplied in revokeChatInviteLink()';
|
||||
return {'error' => 1};
|
||||
}
|
||||
|
||||
$send_args->{chat_id} = $args->{chat_id};
|
||||
$send_args->{invite_link} = $args->{invite_link};
|
||||
|
||||
my $url = "https://api.telegram.org/bot${token}/revokeChatInviteLink";
|
||||
my $api_response = $self->_post_request($url);
|
||||
|
||||
if ($api_response) {
|
||||
return Teapot::Bot::Object::ChatInviteLink->create_from_hash($api_response, $self);
|
||||
}
|
||||
else {
|
||||
return {'error' => 1};
|
||||
}
|
||||
}
|
||||
|
||||
sub _add_getUpdates_handler {
|
||||
my $self = shift;
|
||||
@@ -402,11 +595,18 @@ sub _add_getUpdates_handler {
|
||||
|
||||
$self->ua->get($updateURL => sub {
|
||||
my ($ua, $tx) = @_;
|
||||
my $res = $tx->res->json;
|
||||
my $items = $res->{result};
|
||||
foreach my $item (@{$items}) {
|
||||
$last_update_id = $item->{update_id};
|
||||
$self->_process_message($item);
|
||||
my $res = eval { $tx->res->json; };
|
||||
|
||||
# it looks like we can catch an error here if timeout or something bad occurs,
|
||||
# try not to die in this case or we risk to stuck with $http_active=1 forever
|
||||
if ((defined $res) && $res ne '') {
|
||||
my $items = $res->{result};
|
||||
foreach my $item (@{$items}) {
|
||||
$last_update_id = $item->{update_id};
|
||||
$self->_process_message($item);
|
||||
}
|
||||
} else {
|
||||
cluck "Unable to get update from API: $EVAL_ERROR";
|
||||
}
|
||||
|
||||
$http_active = 0;
|
||||
@@ -425,11 +625,24 @@ sub _process_message {
|
||||
# There can be several types of responses. But only one response.
|
||||
# https://core.telegram.org/bots/api#update
|
||||
my $update;
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{message}, $self) if $item->{message};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_message}, $self) if $item->{edited_message};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{channel_post}, $self) if $item->{channel_post};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_channel_post}, $self) if $item->{edited_channel_post};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{poll}, $self) if $item->{poll};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{message}, $self) if $item->{message};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_message}, $self) if $item->{edited_message};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{channel_post}, $self) if $item->{channel_post};
|
||||
$update = Teapot::Bot::Object::Message->create_from_hash($item->{edited_channel_post}, $self) if $item->{edited_channel_post};
|
||||
# Not yet implemented, we have no InlineQuery object yet
|
||||
#$update = Teapot::Bot::Object::InlineQuery->create_from_hash($tem->{inline_query}, $self) if $item->{inline_query};
|
||||
# Not yet implemented, we have no ChosenInlineResult object yet
|
||||
#$update = Teapot::Bot::Object::ChosenInlineResult->create_from_hash($tem->{chosen_inline_result}, $self) if $item->{chosen_inline_result};
|
||||
# Not yet implemented, we have no callback_query object yet, because we do not use this mechanism, s API should not gi us that shit
|
||||
#$update = Teapot::Bot::Object::CallbackQuery->create_from_hash($tem->{callback_query}, $self) if $item->{callback_query};
|
||||
# Not yet implemented, we have no ShippingQuery object yet
|
||||
#$update = Teapot::Bot::Object::ShippingQuery->create_from_hash($tem->{shipping_query}, $self) if $item->{shipping_query};
|
||||
# Not yet implemented, we have no PreCheckoutQuery object yet
|
||||
#$update = Teapot::Bot::Object::PreCheckoutQuery->create_from_hash($tem->{pre_checkout_query}, $self) if $item->{pre_checkout_query};
|
||||
$update = Teapot::Bot::Object::Poll->create_from_hash($item->{poll}, $self) if $item->{poll};
|
||||
$update = Teapot::Bot::Object::PollAnswer->create_from_hash($item->{poll_answer}, $self) if $item->{poll_answer};
|
||||
$update = Teapot::Bot::Object::ChatMemberUpdated->create_from_hash($item->{my_chat_member}, $self) if $item->{my_chat_member};
|
||||
$update = Teapot::Bot::Object::ChatMemberUpdated->create_from_hash($item->{chat_member}, $self) if $item->{chat_member};
|
||||
|
||||
# if we got to this point without creating a response, it must be a type we
|
||||
# don't handle yet
|
||||
@@ -440,7 +653,15 @@ sub _process_message {
|
||||
|
||||
foreach my $listener (@{ $self->listeners }) {
|
||||
# call the listener code, supplying ourself and the update
|
||||
$listener->($self, $update);
|
||||
my $evalRet = eval {
|
||||
$listener->($self, $update);
|
||||
return 1;
|
||||
};
|
||||
|
||||
unless ($evalRet) {
|
||||
cluck "An error occured during update processing: $EVAL_ERROR";
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
@@ -577,6 +798,25 @@ of Chat User.
|
||||
|
||||
On error returns hash reference with error set to 1
|
||||
|
||||
=head2 kickChatMember
|
||||
|
||||
This is the wrapper around the C<kickChatMember> API method. See
|
||||
L<https://core.telegram.org/bots/api#kickchatmember>.
|
||||
|
||||
Takes chat_id, and user_id as arguments. And optionally until_date and
|
||||
revoke_messages.
|
||||
|
||||
Returns nothing, it's send-only method (Telegram API returns true on success)
|
||||
|
||||
=head2 unbanChatMember
|
||||
|
||||
This is the wrapper around the C<unbanChatMember> API method. See
|
||||
L<https://core.telegram.org/bots/api#unbanchatmember>.
|
||||
|
||||
Takes chat_id, and user_id as arguments. And optionally only_if_banned.
|
||||
|
||||
Returns nothing, it's send-only method (Telegram API returns true on success)
|
||||
|
||||
=head2 getChat
|
||||
|
||||
This is the wrapper around the C<getChat> API method. See
|
||||
@@ -588,6 +828,15 @@ Returns the L<Teapot::Bot::Object::Chat> that represents properties of Chat.
|
||||
|
||||
On error returns hash reference with error set to 1
|
||||
|
||||
=head2 leaveChat
|
||||
|
||||
This is the wrapper around the C<leaveChat> API method. See
|
||||
L<https://core.telegram.org/bots/api#leavechat>.
|
||||
|
||||
Takes chat_id as argument.
|
||||
|
||||
Returns nothing, it's send-only method (Telegram API returns true on success)
|
||||
|
||||
=head2 sendMessage
|
||||
|
||||
See L<https://core.telegram.org/bots/api#sendmessage>.
|
||||
@@ -625,6 +874,47 @@ See L<https://core.telegram.org/bots/api#sendchataction>.
|
||||
|
||||
Returns nothing, it's send-only method (Telegram API returns true on success)
|
||||
|
||||
=head2 exportChatInviteLink
|
||||
|
||||
See L<https://core.telegram.org/bots/api#exportchatinvitelink>
|
||||
|
||||
Takes chat_id as argument.
|
||||
|
||||
Returns a raw api answer.
|
||||
|
||||
On error returns hash reference with error set to 1
|
||||
|
||||
=head2 createChatInviteLink
|
||||
|
||||
See L<https://core.telegram.org/bots/api#createchatinvitelink>
|
||||
|
||||
Takes chat_id as argument. And optionally expire_date and member_limit.
|
||||
|
||||
Returns a L<Teapot::Bot::Object::ChatInviteLink> object.
|
||||
|
||||
On error returns hash reference with error set to 1
|
||||
|
||||
=head2 editChatInviteLink
|
||||
|
||||
See L<https://core.telegram.org/bots/api#editchatinvitelink>
|
||||
|
||||
Takes chat_id and invite_link as arguments. And optionally expire_date
|
||||
and member_limit.
|
||||
|
||||
Returns a L<Teapot::Bot::Object::ChatInviteLink> object.
|
||||
|
||||
On error returns hash reference with error set to 1
|
||||
|
||||
=head2 revokeChatInviteLink
|
||||
|
||||
See L<https://core.telegram.org/bots/api#revokechatinvitelink>
|
||||
|
||||
Takes chat_id and invite_link as arguments.
|
||||
|
||||
Returns a L<Teapot::Bot::Object::ChatInviteLink> object.
|
||||
|
||||
On error returns hash reference with error set to 1
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
@@ -6,15 +6,18 @@ use Mojo::Base 'Teapot::Bot::Object::Base';
|
||||
$Teapot::Bot::Object::Audio::VERSION = '0.022';
|
||||
|
||||
has 'file_id';
|
||||
has 'file_unique_id';
|
||||
has 'duration';
|
||||
has 'performer';
|
||||
has 'title';
|
||||
has 'mime_type';
|
||||
has 'file_size';
|
||||
has 'thumb'; #PhotoSize
|
||||
has 'performer'; # Optional. Performer of the audio as defined by sender or by audio tags
|
||||
has 'title'; # Optional. Title of the audio as defined by sender or by audio tags
|
||||
has 'file_name'; # Optional. Original filename as defined by sender
|
||||
has 'mime_type'; # Optional. MIME type of the file as defined by sender
|
||||
has 'file_size'; # Optional. File size
|
||||
has 'thumb'; # Optional. Thumbnail of the album cover to which the music file belongs
|
||||
|
||||
sub fields {
|
||||
return { scalar => [qw/file_id duration performer title mime_type file_size/],
|
||||
return { scalar => [qw/file_id file_unique_id duration performer title file_name mime_type
|
||||
file_size/],
|
||||
'Teapot::Bot::Object::PhotoSize' => [qw/thumb/],
|
||||
};
|
||||
}
|
||||
|
||||
@@ -42,6 +42,129 @@ sub _field_is_array_of_arrays {
|
||||
return;
|
||||
}
|
||||
|
||||
sub create_from_array {
|
||||
my $class = shift;
|
||||
my $array = shift;
|
||||
my $brain = shift || croak 'No brain supplied to create_from_array()';
|
||||
my $obj = shift || $class->new(_brain => $brain);
|
||||
|
||||
unless (defined $array) {
|
||||
cluck 'Array is undef';
|
||||
return $obj;
|
||||
}
|
||||
|
||||
unless (ref ($array) eq 'ARRAY') {
|
||||
cluck 'Not array ' . Dumper ($hash);
|
||||
return $obj;
|
||||
}
|
||||
|
||||
cluck "Dumping class: " . Dumper ($class);
|
||||
cluck "Dumping array: " . Dumper ($array);
|
||||
Dumping array: $VAR1 = [
|
||||
[
|
||||
{
|
||||
'text' => 'Spotify',
|
||||
'url' => 'https://open.spotify.com/track/44MxUoeZg6FXDlHMrSbVjX'
|
||||
},
|
||||
{
|
||||
'text' => 'Tidal',
|
||||
'url' => 'https://listen.tidal.com/track/159119367'
|
||||
},
|
||||
{
|
||||
'url' => 'https://music.apple.com/us/album/_/1534782030?i=1534782031',
|
||||
'text' => 'Apple'
|
||||
}
|
||||
],
|
||||
[
|
||||
{
|
||||
'text' => 'Deezer',
|
||||
'url' => 'https://www.deezer.com/track/1112603372'
|
||||
},
|
||||
{
|
||||
'text' => 'YouTube',
|
||||
'url' => 'https://music.youtube.com/watch?v=KT1jJDh7ir0'
|
||||
},
|
||||
{
|
||||
'url' => 'https://song.link/s/44MxUoeZg6FXDlHMrSbVjX',
|
||||
'text' => 'eXtra'
|
||||
}
|
||||
]
|
||||
];
|
||||
|
||||
Dumping array: $VAR1 = [
|
||||
[
|
||||
{
|
||||
'callback_data' => 'l85882326|open.spotify.com/track/44MxUoeZg6FXDlHMrSbVjX',
|
||||
'text' => 'Get links'
|
||||
}
|
||||
]
|
||||
];
|
||||
|
||||
# https://core.telegram.org/bots/api#inlinekeyboardmarkup
|
||||
# который содержит в себе тупо массив
|
||||
# Array of Array of Teapot::Bot::Object::InlineKeyboardButton
|
||||
|
||||
# https://core.telegram.org/bots/api#userprofilephotos
|
||||
# аналогично предыдущему содержит
|
||||
# Array of Array of Teapot::Bot::Object::PhotoSize
|
||||
|
||||
# deal with each type of field
|
||||
foreach my $type (keys %{ $class->fields }) {
|
||||
my @fields_of_this_type = @{ $class->fields->{$type} };
|
||||
|
||||
foreach my $field (@fields_of_this_type) {
|
||||
# ignore undefined fields (sic!)
|
||||
next if (! defined $field);
|
||||
|
||||
# ignore fields for which we have no value in the hash
|
||||
next if (! defined $hash->{$field} );
|
||||
|
||||
# warn "type: $type field $field\n";
|
||||
if ($type eq 'scalar') {
|
||||
if ($obj->_field_is_array($field)) {
|
||||
# simple scalar array ref, so just copy it
|
||||
my $val = $hash->{$field};
|
||||
# deal with boolean stuff so we don't pollute our object
|
||||
# with JSON
|
||||
if (ref($val) eq 'JSON::PP::Boolean') {
|
||||
$val = !!$val;
|
||||
}
|
||||
$obj->$field($val);
|
||||
}
|
||||
elsif ($obj->_field_is_array_of_arrays) {
|
||||
croak 'Not yet implemented for scalars';
|
||||
}
|
||||
else {
|
||||
my $val = $hash->{$field};
|
||||
if (ref($val) eq 'JSON::PP::Boolean') {
|
||||
$val = 0+$val;
|
||||
|
||||
}
|
||||
$obj->$field($val);
|
||||
}
|
||||
}
|
||||
|
||||
else {
|
||||
if ($obj->_field_is_array($field)) {
|
||||
my @sub_array;
|
||||
foreach my $data ( @{ $hash->{$field} } ) {
|
||||
push @sub_array, $type->create_from_hash($data, $brain);
|
||||
}
|
||||
$obj->$field(\@sub_array);
|
||||
}
|
||||
elsif ($obj->_field_is_array_of_arrays) {
|
||||
croak 'Not yet implemented for scalars';
|
||||
}
|
||||
else {
|
||||
$obj->$field($type->create_from_hash($hash->{$field}, $brain));
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $obj;
|
||||
}
|
||||
|
||||
# create an object from a hash. Needs to deal with the nested types, and
|
||||
# arrays
|
||||
@@ -57,6 +180,10 @@ sub create_from_hash {
|
||||
}
|
||||
|
||||
unless (ref ($hash) eq 'HASH') {
|
||||
if (ref ($array) eq 'ARRAY') {
|
||||
return create_from_array($class, $hash, $brain);
|
||||
}
|
||||
|
||||
cluck 'Not a hash ' . Dumper ($hash);
|
||||
return $obj;
|
||||
}
|
||||
|
||||
57
lib/Teapot/Bot/Object/ChatInviteLink.pm
Normal file
57
lib/Teapot/Bot/Object/ChatInviteLink.pm
Normal file
@@ -0,0 +1,57 @@
|
||||
package Teapot::Bot::Object::ChatInviteLink;
|
||||
# ABSTRACT: The base class for Telegram message 'ChatInviteLink' type.
|
||||
|
||||
use Mojo::Base 'Teapot::Bot::Object::Base';
|
||||
use Teapot::Bot::Object::User;
|
||||
|
||||
$Teapot::Bot::Object::ChatInviteLink::VERSION = '0.022';
|
||||
|
||||
has 'invite_link';
|
||||
has 'creator';
|
||||
has 'is_primary';
|
||||
has 'is_revoked';
|
||||
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
|
||||
# the chat via this invite link; 1-99999
|
||||
|
||||
sub fields {
|
||||
return {
|
||||
'scalar' => [qw/invite_link is_primary is_revoked expire_date expire_date member_limit/],
|
||||
'Teapot::Bot::Object::User' => [qw/creator/],
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Teapot::Bot::Object::ChatInviteLink - The base class for Telegram message 'ChatInviteLink' type
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.022
|
||||
|
||||
=head1 DESCRIPTION
|
||||
The base class for Telegram message 'ChatInviteLink' type.
|
||||
|
||||
See L<https://core.telegram.org/bots/api#chatinvitelink> for details of the
|
||||
attributes available for L<Teapot::Bot::Object::ChatInviteLink> objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
@@ -13,9 +13,14 @@ has 'custom_title'; # optional. Owner and administrators only.
|
||||
has 'is_anonymous'; # Optional. Owner and administrators only.
|
||||
|
||||
has 'can_be_edited'; # optional. Administrators only.
|
||||
has 'can_manage_chat' # Optional. Administrators only. True, if the administrator can access the chat event
|
||||
# log, chat statistics, message statistics in channels, see channel members, see
|
||||
# anonymous administrators in supergroups and ignore slow mode. Implied by any other
|
||||
# administrator privilege
|
||||
has 'can_post_messages'; # optional. Administrators only.
|
||||
has 'can_edit_messages'; # optional. Administrators only.
|
||||
has 'can_delete_messages'; # optional. Administrators only.
|
||||
has 'can_manage_voice_chats' # Optional. Administrators only. True, if the administrator can manage voice chats
|
||||
has 'can_restrict_members'; # optional. Administrators only.
|
||||
has 'can_promote_members'; # optional. Administrators only.
|
||||
has 'can_change_info'; # optional. Administrators and restricted only.
|
||||
@@ -31,10 +36,11 @@ has 'until_date'; # optional. Restricted and kicked only.
|
||||
|
||||
sub fields {
|
||||
return {
|
||||
'scalar' => [qw/status custom_title is_anonymous can_be_edited can_post_messages can_edit_messages
|
||||
can_delete_messages can_restrict_members can_promote_members can_change_info
|
||||
can_invite_users can_pin_messages is_member can_send_messages
|
||||
can_send_media_messages can_send_polls can_send_other_messages can_add_web_page_previews until_date/],
|
||||
'scalar' => [qw/status custom_title is_anonymous can_be_edited can_manage_chat can_post_messages
|
||||
can_edit_messages can_delete_messages can_manage_voice_chats can_restrict_members
|
||||
can_promote_members can_change_info can_invite_users can_pin_messages is_member
|
||||
can_send_messages can_send_media_messages can_send_polls can_send_other_messages
|
||||
can_add_web_page_previews until_date/],
|
||||
'Teapot::Bot::Object::User' => [qw/user/],
|
||||
};
|
||||
}
|
||||
|
||||
63
lib/Teapot/Bot/Object/ChatMemberUpdated.pm
Normal file
63
lib/Teapot/Bot/Object/ChatMemberUpdated.pm
Normal file
@@ -0,0 +1,63 @@
|
||||
package Teapot::Bot::Object::ChatMemberUpdated;
|
||||
# ABSTRACT: The base class for Telegram 'ChatMemberUpdated' type objects
|
||||
|
||||
use Mojo::Base 'Teapot::Bot::Object::Base';
|
||||
use Teapot::Bot::Object::Chat;
|
||||
use Teapot::Bot::Object::User;
|
||||
use Teapot::Bot::Object::ChatMember;
|
||||
use Teapot::Bot::Object::ChatInviteLink;
|
||||
|
||||
$Teapot::Bot::Object::ChatMemberUpdated::VERSION = '0.022';
|
||||
|
||||
has 'chat';
|
||||
has 'from';
|
||||
has 'date';
|
||||
has 'old_chat_member';
|
||||
has 'new_chat_member';
|
||||
has 'invite_link'; # Optional. Chat invite link, which was used by the user to join the chat; for joining by
|
||||
# invite link events only.
|
||||
|
||||
sub fields {
|
||||
return {
|
||||
'Teapot::Bot::Object::Chat' => [qw/chat/],
|
||||
'Teapot::Bot::Object::User' => [qw/from/],
|
||||
'scalar' => [qw/date/],
|
||||
'Teapot::Bot::Object::ChatMember' => [qw/old_chat_member new_chat_member/],
|
||||
'Teapot::Bot::Object::ChatInviteLink' => [qw/invite_link/]
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Teapot::Bot::Object::ChatMemberUpdated - The base class for Telegram 'ChatMemberUpdated' type objects
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.022
|
||||
|
||||
=head1 DESCRIPTION
|
||||
The base class for Telegram 'ChatMemberUpdated' type objects.
|
||||
|
||||
See L<https://core.telegram.org/bots/api#chatmemberupdated> for details of the
|
||||
attributes available for L<Teapot::Bot::Object::ChatMemberUpdated> objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
@@ -29,6 +29,10 @@ use Teapot::Bot::Object::PassportData;
|
||||
use Teapot::Bot::Object::InlineKeyboardMarkup;
|
||||
use Teapot::Bot::Object::ProximityAlertTriggered;
|
||||
use Teapot::Bot::Object::Dice;
|
||||
use Teapot::Bot::Object::MessageAutoDeleteTimerChanged;
|
||||
use Teapot::Bot::Object::VoiceChatStarted;
|
||||
use Teapot::Bot::Object::VoiceChatEnded;
|
||||
use Teapot::Bot::Object::VoiceChatParticipantsInvited;
|
||||
|
||||
use Data::Dumper;
|
||||
use Carp qw(cluck);
|
||||
@@ -78,6 +82,7 @@ has 'delete_chat_photo';
|
||||
has 'group_chat_created';
|
||||
has 'supergroup_chat_created';
|
||||
has 'channel_chat_created';
|
||||
has 'message_auto_delete_timer_changed'; # Optional. Service message: auto-delete timer settings changed in the chat
|
||||
has 'migrate_to_chat_id';
|
||||
has 'migrate_from_chat_id';
|
||||
has 'pinned_message'; # Message
|
||||
@@ -86,6 +91,9 @@ has 'successful_payment'; # SuccessfulPayment
|
||||
has 'connected_website';
|
||||
has 'passport_data'; # PassportData
|
||||
has 'proximity_alert_triggered';
|
||||
has 'voice_chat_started'; # Optional. Service message: voice chat started
|
||||
has 'voice_chat_ended'; # Optional. Service message: voice chat ended
|
||||
has 'voice_chat_participants_invited'; # Optional. Service message: new participants invited to a voice chat
|
||||
has 'reply_markup'; # Array of InlineKeyboardMarkup
|
||||
|
||||
sub fields {
|
||||
@@ -126,6 +134,10 @@ sub fields {
|
||||
'Teapot::Bot::Object::InlineKeyboardMarkup' => [qw/reply_markup/],
|
||||
'Teapot::Bot::Object::ProximityAlertTriggered' => [qw/proximity_alert_triggered/],
|
||||
'Teapot::Bot::Object::Dice' => [qw/dice/],
|
||||
'Teapot::Bot::Object::MessageAutoDeleteTimerChanged' => [qw/message_auto_delete_timer_changed/],
|
||||
'Teapot::Bot::Object::VoiceChatStarted' => [qw/voice_chat_started/],
|
||||
'Teapot::Bot::Object::VoiceChatEnded' => [qw/voice_chat_ended/],
|
||||
'Teapot::Bot::Object::VoiceChatParticipantsInvited' => [qw/voice_chat_participants_invited/],
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
49
lib/Teapot/Bot/Object/MessageAutoDeleteTimerChanged.pm
Normal file
49
lib/Teapot/Bot/Object/MessageAutoDeleteTimerChanged.pm
Normal file
@@ -0,0 +1,49 @@
|
||||
package Teapot::Bot::Object::MessageAutoDeleteTimerChanged;
|
||||
# ABSTRACT: The base class for Telegram 'MessageAutoDeleteTimerChanged' type objects
|
||||
|
||||
use Mojo::Base 'Teapot::Bot::Object::Base';
|
||||
|
||||
$Teapot::Bot::Object::MessageAutoDeleteTimerChanged::VERSION = '0.022';
|
||||
|
||||
has 'message_auto_delete_time';
|
||||
|
||||
sub fields {
|
||||
return {
|
||||
'scalar' => [qw/message_auto_delete_time/],
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Teapot::Bot::Object::MessageAutoDeleteTimerChanged - The base class for Telegram 'MessageAutoDeleteTimerChanged' type objects
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.022
|
||||
|
||||
=head1 DESCRIPTION
|
||||
The base class for Telegram 'MessageAutoDeleteTimerChanged' type objects.
|
||||
|
||||
See L<https://core.telegram.org/bots/api#messageautodeletetimerchanged> for details of the
|
||||
attributes available for L<Teapot::Bot::Object::MessageAutoDeleteTimerChanged> objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
@@ -7,16 +7,19 @@ use Teapot::Bot::Object::PhotoSize;
|
||||
$Teapot::Bot::Object::Video::VERSION = '0.022';
|
||||
|
||||
has 'file_id';
|
||||
has 'file_unique_id';
|
||||
has 'width';
|
||||
has 'height';
|
||||
has 'duration';
|
||||
has 'thumb'; #PhotoSize
|
||||
has 'mime_type';
|
||||
has 'file_size';
|
||||
has 'thumb'; # Optional. Video thumbnail
|
||||
has 'file_name'; # Optional. Original filename as defined by sender
|
||||
has 'mime_type'; # Optional. Mime type of a file as defined by sender
|
||||
has 'file_size'; # Optional. File size
|
||||
|
||||
sub fields {
|
||||
return {
|
||||
scalar => [qw/file_id width height duration mime_type file_size/],
|
||||
scalar => [qw/file_id file_unique_id width height duration file_name mime_type
|
||||
file_size/],
|
||||
'Teapot::Bot::Object::PhotoSize' => [qw/thumb/]
|
||||
};
|
||||
}
|
||||
|
||||
48
lib/Teapot/Bot/Object/VoiceChatEnded.pm
Normal file
48
lib/Teapot/Bot/Object/VoiceChatEnded.pm
Normal file
@@ -0,0 +1,48 @@
|
||||
package Teapot::Bot::Object::VoiceChatEnded;
|
||||
# ABSTRACT: The base class for Telegram message 'VoiceChatEnded' type.
|
||||
|
||||
use Mojo::Base 'Teapot::Bot::Object::Base';
|
||||
|
||||
$Teapot::Bot::Object::VoiceChatEnded::VERSION = '0.022';
|
||||
|
||||
# This object represents a service message about a voice chat started in the chat. Currently holds no information.
|
||||
has 'duartion';
|
||||
|
||||
sub fields {
|
||||
return { scalar => [qw/duration/] };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Teapot::Bot::Object::VoiceChatEnded - The base class for Telegram message 'VoiceChatEnded' type
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.022
|
||||
|
||||
=head1 DESCRIPTION
|
||||
The base class for Telegram message 'VoiceChatEnded' type.
|
||||
|
||||
See L<https://core.telegram.org/bots/api#voicechatended> for details of the
|
||||
attributes available for L<Teapot::Bot::Object::VoiceChatEnded> objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
53
lib/Teapot/Bot/Object/VoiceChatParticipantsInvited.pm
Normal file
53
lib/Teapot/Bot/Object/VoiceChatParticipantsInvited.pm
Normal file
@@ -0,0 +1,53 @@
|
||||
package Teapot::Bot::Object::VoiceChatParticipantsInvited;
|
||||
# ABSTRACT: The base class for Telegram message 'VoiceChatParticipantsInvited' type.
|
||||
|
||||
use Mojo::Base 'Teapot::Bot::Object::Base';
|
||||
use Teapot::Bot::Object::User;
|
||||
|
||||
$Teapot::Bot::Object::VoiceChatParticipantsInvited::VERSION = '0.022';
|
||||
|
||||
# This object represents a service message about a voice chat started in the chat. Currently holds no information.
|
||||
has 'users';
|
||||
|
||||
sub fields {
|
||||
return { 'Teapot::Bot::Object::User' => [qw/users/] };
|
||||
}
|
||||
|
||||
sub arrays {
|
||||
return qw/users/;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Teapot::Bot::Object::VoiceChatParticipantsInvited - The base class for Telegram message 'VoiceChatParticipantsInvited' type
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.022
|
||||
|
||||
=head1 DESCRIPTION
|
||||
The base class for Telegram message 'VoiceChatParticipantsInvited' type.
|
||||
|
||||
See L<https://core.telegram.org/bots/api#voicechatparticipantsinvited> for details of the
|
||||
attributes available for L<Teapot::Bot::Object::VoiceChatParticipantsInvited> objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
48
lib/Teapot/Bot/Object/VoiceChatStarted.pm
Normal file
48
lib/Teapot/Bot/Object/VoiceChatStarted.pm
Normal file
@@ -0,0 +1,48 @@
|
||||
package Teapot::Bot::Object::VoiceChatStarted;
|
||||
# ABSTRACT: The base class for Telegram message 'VoiceChatStarted' type.
|
||||
|
||||
use Mojo::Base 'Teapot::Bot::Object::Base';
|
||||
|
||||
$Teapot::Bot::Object::VoiceChatStarted::VERSION = '0.022';
|
||||
|
||||
# This object represents a service message about a voice chat started in the chat. Currently holds no information.
|
||||
has 'stub';
|
||||
|
||||
sub fields {
|
||||
return { scalar => [qw/stub/] };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Teapot::Bot::Object::VoiceChatStarted - The base class for Telegram message 'VoiceChatStarted' type
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.022
|
||||
|
||||
=head1 DESCRIPTION
|
||||
The base class for Telegram message 'VoiceChatStarted' type.
|
||||
|
||||
See L<https://core.telegram.org/bots/api#voicechatstarted> for details of the
|
||||
attributes available for L<Teapot::Bot::Object::VoiceChatStarted> objects.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Sergei Fedosov <eleksir@gmail.com>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
This software is copyright (c) 2021 by Sergei Fedosov <eleksir@gmail.com>.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
@@ -13,14 +13,18 @@ use Math::Random::Secure qw (irand);
|
||||
use conf qw (loadConf);
|
||||
use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status plugin_toggle plugin_status pluginEnabled);
|
||||
use archeologist qw (dig);
|
||||
use buni qw (buni);
|
||||
use drink qw (drink);
|
||||
use fisher qw (fish);
|
||||
use fortune qw (fortune);
|
||||
use friday qw (friday);
|
||||
use image qw (kitty fox oboobs obutts);
|
||||
use image qw (kitty fox oboobs obutts rabbit owl);
|
||||
use karma qw (karmaSet karmaGet);
|
||||
use lat qw (latAnswer);
|
||||
use monkeyuser qw (monkeyuse);
|
||||
use util qw (trim);
|
||||
use weather qw (weather);
|
||||
use xkcd qw (xkcd);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
@@ -68,9 +72,21 @@ sub command {
|
||||
} elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) {
|
||||
my $city = substr $text, 3;
|
||||
$reply = weather $city;
|
||||
} elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') {
|
||||
$reply = kitty ();
|
||||
} elsif (substr ($text, 1) eq 'buni') {
|
||||
$msg->typing ();
|
||||
$reply = buni ();
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'monkeyuser') {
|
||||
$msg->typing ();
|
||||
$reply = monkeyuser ();
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') {
|
||||
$msg->typing ();
|
||||
$reply = kitty ();
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
@@ -91,9 +107,15 @@ sub command {
|
||||
}
|
||||
|
||||
$reply = karmaGet ($chatid, $mytext);
|
||||
} elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') {
|
||||
$reply = fox ();
|
||||
} elsif (substr ($text, 1) eq 'xkcd') {
|
||||
$msg->typing ();
|
||||
$reply = xkcd ();
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') {
|
||||
$msg->typing ();
|
||||
$reply = fox ();
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
@@ -102,6 +124,11 @@ sub command {
|
||||
$reply = rabbit ();
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') {
|
||||
$msg->typing ();
|
||||
$reply = owl ();
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (
|
||||
substr ($text, 1) eq 'tits' ||
|
||||
substr ($text, 1) eq 'boobs' ||
|
||||
@@ -111,8 +138,8 @@ sub command {
|
||||
substr ($text, 1) eq 'сисечки'
|
||||
) {
|
||||
if (pluginEnabled $chatid, 'oboobs') {
|
||||
$reply = oboobs ();
|
||||
$msg->typing ();
|
||||
$reply = oboobs ();
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
}
|
||||
@@ -126,8 +153,8 @@ sub command {
|
||||
substr ($text, 1) eq 'попка'
|
||||
) {
|
||||
if (pluginEnabled $chatid, 'obutts') {
|
||||
$reply = obutts ();
|
||||
$msg->typing ();
|
||||
$reply = obutts ();
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
}
|
||||
@@ -139,15 +166,19 @@ sub command {
|
||||
$reply = sprintf "```\n%s\n```\n", trim (fortune ());
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
|
||||
$reply = dig $highlight;
|
||||
} elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') {
|
||||
$msg->typing ();
|
||||
$reply = drink ();
|
||||
sleep (irand (2) + 1);
|
||||
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
|
||||
$msg->typing ();
|
||||
$reply = dig $highlight;
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
} elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fishing' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка' ) {
|
||||
$reply = fish $highlight;
|
||||
$msg->typing ();
|
||||
$reply = fish $highlight;
|
||||
sleep (irand (2) + 1);
|
||||
$msg->replyMd ($reply);
|
||||
return;
|
||||
@@ -155,9 +186,11 @@ sub command {
|
||||
$reply = << "MYHELP";
|
||||
```
|
||||
${csign}help | ${csign}помощь - список команд
|
||||
${csign}bunny | ${csign}rabbit | ${csign}кролик - кролик (бета-версия)
|
||||
${csign}buni - рандомный стрип hapi buni
|
||||
${csign}bunny | ${csign}rabbit | ${csign}кролик - кролик
|
||||
${csign}cat | ${csign}кис - кошечка
|
||||
${csign}dig | ${csign}копать - заняться археологией
|
||||
${csign}drink | ${csign}праздник - какой сегодня праздник?
|
||||
${csign}fish | ${csign}рыба | ${csign}рыбка - порыбачить
|
||||
${csign}fishing | ${csign}рыбалка - порыбачить
|
||||
${csign}f | ${csign}ф - рандомная фраза из сборника цитат fortune_mod
|
||||
@@ -165,9 +198,12 @@ ${csign}fortune | ${csign}фортунка - рандомная фраз
|
||||
${csign}fox | ${csign}лис - лисичка
|
||||
${csign}friday | ${csign}пятница - а не пятница ли сегодня?
|
||||
${csign}lat | ${csign}лат - сгенерить фразу из крылатых латинских выражений
|
||||
${csign}monkeyuser - рандомный стрип MonkeyUser
|
||||
${csign}owl | ${csign}сова - сова
|
||||
${csign}ping | ${csign}пинг - попинговать бота
|
||||
${csign}ver | ${csign}version | ${csign}версия - что-то про версию ПО
|
||||
${csign}w город | ${csign}п город - погода в указанном городе
|
||||
${csign}xkcd - рандомный стрип с сайта xkcd.ru
|
||||
${csign}karma фраза | ${csign}карма фраза - посмотреть карму фразы
|
||||
фраза-- | фраза++ - убавить или добавить карму фразе
|
||||
```
|
||||
|
||||
58
lib/buni.pm
Normal file
58
lib/buni.pm
Normal file
@@ -0,0 +1,58 @@
|
||||
package buni;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw (cluck);
|
||||
use HTML::TokeParser;
|
||||
use Mojo::UserAgent;
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (buni);
|
||||
|
||||
sub buni {
|
||||
my $r;
|
||||
my $ret = 'Нету Buni';
|
||||
|
||||
for (1..3) {
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||
$r = $ua->get ('http://www.bunicomic.com/?random&nocache=1')->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
if ($r->is_success) {
|
||||
my $p = HTML::TokeParser->new(\$r->body);
|
||||
my @a;
|
||||
|
||||
# additional {} required in order "last" to work properly :)
|
||||
{
|
||||
do {
|
||||
$#a = -1;
|
||||
@a = $p->get_tag('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
|
||||
if (defined $a[0][1]->{property} && $a[0][1]->{property} eq 'og:image') {
|
||||
$ret = sprintf '[buni](%s)', $a[0][1]->{content};
|
||||
last;
|
||||
}
|
||||
|
||||
} while ($#{$a[0]} > 1);
|
||||
}
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
111
lib/drink.pm
Normal file
111
lib/drink.pm
Normal file
@@ -0,0 +1,111 @@
|
||||
package drink;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use CHI;
|
||||
use CHI::Driver::BerkeleyDB;
|
||||
use DateTime;
|
||||
use English qw ( -no_match_vars );
|
||||
use Encode;
|
||||
use Carp qw (cluck);
|
||||
use HTML::TokeParser;
|
||||
use Mojo::Log;
|
||||
use Mojo::UserAgent::Cached;
|
||||
use POSIX qw (strftime);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (drink);
|
||||
|
||||
my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr);
|
||||
|
||||
sub drink {
|
||||
my $r;
|
||||
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
|
||||
my ($dayNum, $monthNum) = (localtime ())[3, 4];
|
||||
my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum;
|
||||
|
||||
# Those POSIX assholes just forgot to add unix timestamps without TZ offset, so...
|
||||
my ($mday, $mon, $year) = (gmtime ())[3, 4, 5];
|
||||
my $offset = strftime ('%z', gmtime ());
|
||||
my $offsetMinutes = (substr $offset, -2) * 60;
|
||||
my $offsetHours = (substr $offset, 1, 2) * 60 * 60;
|
||||
my $offsetSign;
|
||||
|
||||
if ((substr $offset, 0, 1) eq '+') {
|
||||
$offsetSign = 1;
|
||||
}
|
||||
|
||||
my $expirationDate = DateTime->new (
|
||||
year => $year + 1900,
|
||||
month => $mon + 1,
|
||||
day => $mday,
|
||||
hour => 0,
|
||||
minute => 0,
|
||||
second => 0
|
||||
)->add (days => 1)->strftime ('%s');
|
||||
|
||||
if ((substr $offset, 0, 1) eq '+') {
|
||||
$expirationDate = $expirationDate - $offsetHours - $offsetMinutes;
|
||||
} else {
|
||||
$expirationDate = $expirationDate + $offsetHours + $offsetMinutes;
|
||||
}
|
||||
|
||||
for (1..3) {
|
||||
my $ua = Mojo::UserAgent::Cached->new->connect_timeout (3);
|
||||
$ua->cache_agent(
|
||||
CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => 'data/cache',
|
||||
namespace => __PACKAGE__,
|
||||
expires_at => $expirationDate,
|
||||
expires_on_backend => 1,
|
||||
)
|
||||
);
|
||||
# just to make Mojo::UserAgent::Cached happy
|
||||
$ua->logger (Mojo::Log->new (path => '/dev/null', level => 'error'));
|
||||
$r = $ua->get ($url => {'Accept-Language' => 'ru-RU', 'Accept-Charset' => 'utf-8'})->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
if ($r->is_success) {
|
||||
my $p = HTML::TokeParser->new(\$r->body);
|
||||
my @a;
|
||||
my @holyday;
|
||||
|
||||
do {
|
||||
$#a = -1;
|
||||
@a = $p->get_tag('span'); ## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
|
||||
if ($#{$a[0]} > 2 && defined $a[0][1]->{itemprop} && $a[0][1]->{itemprop} eq 'text') {
|
||||
push @holyday,'* ' . decode ('UTF-8', $p->get_trimmed_text ('/span'));
|
||||
}
|
||||
|
||||
} while ($#{$a[0]} > 1);
|
||||
|
||||
if ($#holyday > 0) {
|
||||
# cut off something weird, definely not a "holyday"
|
||||
$#holyday = $#holyday - 1;
|
||||
}
|
||||
|
||||
if ($#holyday > 0) {
|
||||
$ret = join "\n", @holyday;
|
||||
}
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
634
lib/flickr.pm
Normal file
634
lib/flickr.pm
Normal file
@@ -0,0 +1,634 @@
|
||||
package flickr;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw (cluck);
|
||||
use Digest::HMAC_SHA1 qw (hmac_sha1);
|
||||
use File::Path qw (make_path);
|
||||
use Math::Random::Secure qw (irand);
|
||||
use MIME::Base64;
|
||||
use Mojo::UserAgent;
|
||||
use SQLite_File;
|
||||
use URI::Encode::XS qw (uri_encode);
|
||||
|
||||
use conf qw (loadConf);
|
||||
use util qw (urlencode);
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (flickr_init flickr_by_tags flickr_by_text flickr_test_login);
|
||||
|
||||
my $c = loadConf ();
|
||||
my $dir = $c->{image}->{dir};
|
||||
|
||||
my $flickr_consumer_key = $c->{image}->{flickr}->{consumer_key};
|
||||
my $flickr_consumer_secret = $c->{image}->{flickr}->{consumer_secret};
|
||||
my $flickr_verifier = $c->{image}->{flickr}->{verifier};
|
||||
my $flickr_request_token_url = 'https://www.flickr.com/services/oauth/request_token';
|
||||
my $flickr_authorization_url = 'https://www.flickr.com/services/oauth/authorize';
|
||||
my $flickr_access_token_url = 'https://www.flickr.com/services/oauth/access_token';
|
||||
my $flickr_callback_url = 'http://www.example.com';
|
||||
my $flickr_api_url = 'https://www.flickr.com/services/rest/';
|
||||
|
||||
sub mknonce {
|
||||
# make random number, 8 symbols in length
|
||||
my $nonce = sprintf '%08d', irand (99999999);
|
||||
return $nonce;
|
||||
}
|
||||
|
||||
sub flickerSignReq {
|
||||
my %p = @_;
|
||||
my $string;
|
||||
my $hmac;
|
||||
|
||||
if ($p{type} eq 'request_token') {
|
||||
my @parameters;
|
||||
delete $p{type};
|
||||
push @parameters, 'oauth_signature_method=HMAC-SHA1';
|
||||
push @parameters, 'oauth_version=1.0';
|
||||
push @parameters, sprintf 'oauth_callback=%s', uri_encode ($flickr_callback_url);
|
||||
push @parameters, sprintf 'oauth_consumer_key=%s', $flickr_consumer_key;
|
||||
|
||||
foreach my $param (keys %p) {
|
||||
push @parameters, sprintf ('%s=%s', $param, $p{$param});
|
||||
}
|
||||
|
||||
$string = sprintf 'GET&%s&', uri_encode ($flickr_request_token_url);
|
||||
$string .= uri_encode (join '&', sort (@parameters));
|
||||
# Thanks to twitter api dev portal, they explain this particular case: while we requesting this token
|
||||
# we do not yet know access_token secret, so we just omit it in this signature
|
||||
# https://developer.twitter.com/en/docs/authentication/oauth-1-0a/creating-a-signature
|
||||
$hmac = Digest::HMAC_SHA1->new (sprintf '%s&', uri_encode ($flickr_consumer_secret));
|
||||
} elsif ($p{type} eq 'access_token') {
|
||||
my @parameters;
|
||||
my $flickr_request_token_secret = $p{oauth_token_secret};
|
||||
delete $p{oauth_token_secret};
|
||||
delete $p{type};
|
||||
push @parameters, 'oauth_signature_method=HMAC-SHA1';
|
||||
push @parameters, 'oauth_version=1.0';
|
||||
push @parameters, sprintf 'oauth_consumer_key=%s', $flickr_consumer_key;
|
||||
|
||||
foreach my $param (keys %p) {
|
||||
push @parameters, sprintf ('%s=%s', $param, $p{$param});
|
||||
}
|
||||
|
||||
$string = sprintf 'GET&%s&', uri_encode ($flickr_access_token_url);
|
||||
$string .= uri_encode (join '&', sort (@parameters));
|
||||
$hmac = Digest::HMAC_SHA1->new (sprintf '%s&%s', uri_encode ($flickr_consumer_secret), uri_encode ($flickr_request_token_secret));
|
||||
} elsif ($p{type} eq 'test_login' || $p{type} eq 'search_text' || $p{type} eq 'search_tags') {
|
||||
my @parameters;
|
||||
my $flickr_request_token_secret = $p{oauth_token_secret};
|
||||
delete $p{oauth_token_secret};
|
||||
delete $p{type};
|
||||
|
||||
foreach my $param (keys %p) {
|
||||
push @parameters, sprintf ('%s=%s', $param, $p{$param});
|
||||
}
|
||||
|
||||
$string = sprintf 'GET&%s&', uri_encode ($flickr_api_url);
|
||||
$string .= uri_encode (join '&', sort (@parameters));
|
||||
$hmac = Digest::HMAC_SHA1->new (sprintf '%s&%s', uri_encode ($flickr_consumer_secret), uri_encode ($flickr_request_token_secret));
|
||||
}
|
||||
|
||||
$hmac->add ($string);
|
||||
return encode_base64 ($hmac->digest, '');
|
||||
}
|
||||
|
||||
sub flickrRequestToken {
|
||||
my $oauth_timestamp = time ();
|
||||
my $oauth_nonce = mknonce ();
|
||||
|
||||
my $oauth_signature = flickerSignReq (
|
||||
type => 'request_token',
|
||||
oauth_timestamp => $oauth_timestamp,
|
||||
oauth_nonce => $oauth_nonce
|
||||
);
|
||||
|
||||
my $url = $flickr_request_token_url . sprintf (
|
||||
'?oauth_nonce=%s&oauth_timestamp=%s&oauth_consumer_key=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&&oauth_signature=%s&oauth_callback=%s',
|
||||
$oauth_nonce,
|
||||
$oauth_timestamp,
|
||||
$flickr_consumer_key,
|
||||
uri_encode ($oauth_signature),
|
||||
uri_encode ($flickr_callback_url)
|
||||
);
|
||||
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
my $r = $ua->get ($url)->result;
|
||||
my %params;
|
||||
|
||||
if ($r->is_success) {
|
||||
# they ignore format=json, so...
|
||||
%params = map {split /=/} split /&/, $r->body;
|
||||
} else {
|
||||
say "Something bad returns from flickr api: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
}
|
||||
|
||||
return %params;
|
||||
}
|
||||
|
||||
sub flickrAccessToken {
|
||||
my $flickr_request_token = shift;
|
||||
my $flickr_request_token_secret = shift;
|
||||
my $flickr_verifier = shift; ## no critic (Variables::ProhibitReusedNames)
|
||||
|
||||
my $oauth_timestamp = time ();
|
||||
my $oauth_nonce = mknonce ();
|
||||
|
||||
my $oauth_signature = flickerSignReq (
|
||||
type => 'access_token',
|
||||
oauth_timestamp => $oauth_timestamp,
|
||||
oauth_nonce => $oauth_nonce,
|
||||
oauth_token => $flickr_request_token,
|
||||
oauth_token_secret => $flickr_request_token_secret,
|
||||
oauth_verifier => $flickr_verifier
|
||||
);
|
||||
|
||||
my $url = $flickr_access_token_url . sprintf (
|
||||
'?oauth_nonce=%s&oauth_timestamp=%s&oauth_verifier=%s&oauth_consumer_key=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s',
|
||||
$oauth_nonce,
|
||||
$oauth_timestamp,
|
||||
$flickr_verifier,
|
||||
$flickr_consumer_key,
|
||||
$flickr_request_token,
|
||||
uri_encode ($oauth_signature)
|
||||
);
|
||||
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
my $r = $ua->get ($url)->result;
|
||||
my %params;
|
||||
|
||||
if ($r->is_success) {
|
||||
# they ignore format=json
|
||||
%params = map {split /=/} split /&/, $r->body;
|
||||
} else {
|
||||
say "Something bad returns from flickr api: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
}
|
||||
|
||||
return %params;
|
||||
}
|
||||
|
||||
sub flickrAuthorization {
|
||||
my $flickr_request_token = shift;
|
||||
|
||||
my $url = $flickr_authorization_url . sprintf (
|
||||
'?oauth_token=%s&perms=read',
|
||||
$flickr_request_token,
|
||||
);
|
||||
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
my $r = $ua->get ($url)->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
return $r->url;
|
||||
} else {
|
||||
say "Something went wrong: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
sub flickrTestLogin {
|
||||
my $flickr_access_token = shift;
|
||||
my $flickr_access_token_secret = shift;
|
||||
|
||||
my $oauth_timestamp = time ();
|
||||
my $oauth_nonce = mknonce ();
|
||||
|
||||
my $oauth_signature = flickerSignReq (
|
||||
nojsoncallback => 1,
|
||||
oauth_nonce => $oauth_nonce,
|
||||
format => 'json',
|
||||
oauth_consumer_key => $flickr_consumer_key,
|
||||
oauth_timestamp => $oauth_timestamp,
|
||||
type => 'test_login',
|
||||
method => 'flickr.test.login',
|
||||
oauth_token => $flickr_access_token,
|
||||
oauth_token_secret => $flickr_access_token_secret,
|
||||
oauth_signature_method => 'HMAC-SHA1',
|
||||
oauth_version => '1.0'
|
||||
);
|
||||
|
||||
my $url = $flickr_api_url . sprintf (
|
||||
'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.test.login',
|
||||
$oauth_nonce,
|
||||
$flickr_consumer_key,
|
||||
$oauth_timestamp,
|
||||
$flickr_access_token,
|
||||
uri_encode ($oauth_signature)
|
||||
);
|
||||
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
my $r = $ua->get ($url)->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
my $response = eval {
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
if (defined $response) {
|
||||
say Dumper $response; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 1;
|
||||
} else {
|
||||
say "Flickr api returns incorrect json: $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
say "HTTP status code not 200: $r->code, $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub flickrSearchByText {
|
||||
my $flickr_access_token = shift;
|
||||
my $flickr_access_token_secret = shift;
|
||||
my $text = shift;
|
||||
|
||||
my $oauth_timestamp = time ();
|
||||
my $oauth_nonce = mknonce ();
|
||||
|
||||
my $oauth_signature = flickerSignReq (
|
||||
nojsoncallback => 1,
|
||||
oauth_nonce => $oauth_nonce,
|
||||
format => 'json',
|
||||
oauth_consumer_key => $flickr_consumer_key,
|
||||
oauth_timestamp => $oauth_timestamp,
|
||||
type => 'search_text',
|
||||
content_type => 1,
|
||||
media => 'photos',
|
||||
method => 'flickr.photos.search',
|
||||
text => $text,
|
||||
per_page => 1,
|
||||
oauth_token => $flickr_access_token,
|
||||
oauth_token_secret => $flickr_access_token_secret,
|
||||
oauth_signature_method => 'HMAC-SHA1',
|
||||
oauth_version => '1.0'
|
||||
);
|
||||
|
||||
my $url = $flickr_api_url . sprintf (
|
||||
'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=1&text=%s',
|
||||
$oauth_nonce,
|
||||
$flickr_consumer_key,
|
||||
$oauth_timestamp,
|
||||
$flickr_access_token,
|
||||
uri_encode ($oauth_signature),
|
||||
uri_encode ($text)
|
||||
);
|
||||
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
my $r = $ua->get ($url)->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
my $response = eval {
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
if (defined $response) {
|
||||
# lets make another query, this time with random picture
|
||||
my $page = irand int ($response->{photos}->{total} / 500);
|
||||
$oauth_timestamp = time ();
|
||||
$oauth_nonce = mknonce ();
|
||||
$oauth_signature = flickerSignReq (
|
||||
nojsoncallback => 1,
|
||||
oauth_nonce => $oauth_nonce,
|
||||
format => 'json',
|
||||
oauth_consumer_key => $flickr_consumer_key,
|
||||
oauth_timestamp => $oauth_timestamp,
|
||||
type => 'search_text',
|
||||
content_type => 1,
|
||||
media => 'photos',
|
||||
method => 'flickr.photos.search',
|
||||
text => $text,
|
||||
page => $page,
|
||||
per_page => 500,
|
||||
oauth_token => $flickr_access_token,
|
||||
oauth_token_secret => $flickr_access_token_secret,
|
||||
oauth_signature_method => 'HMAC-SHA1',
|
||||
oauth_version => '1.0'
|
||||
);
|
||||
|
||||
$url = $flickr_api_url . sprintf (
|
||||
'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=500&page=%d&text=%s',
|
||||
$oauth_nonce,
|
||||
$flickr_consumer_key,
|
||||
$oauth_timestamp,
|
||||
$flickr_access_token,
|
||||
uri_encode ($oauth_signature),
|
||||
$page,
|
||||
uri_encode ($text)
|
||||
);
|
||||
|
||||
$ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
$r = $ua->get ($url)->result;
|
||||
|
||||
|
||||
if ($r->is_success) {
|
||||
$response = eval {
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
if (defined $response) {
|
||||
return $response;
|
||||
} else {
|
||||
cluck "Flickr api returns incorrect json: $r->message";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Flickr api returns incorrect json: $r->message";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Flickr api returns incorrect json: $r->message";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "HTTP status code not 200: $r->code, $r->message";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub flickrSearchByTags {
|
||||
my $flickr_access_token = shift;
|
||||
my $flickr_access_token_secret = shift;
|
||||
my $tags = shift;
|
||||
|
||||
my $oauth_timestamp = time ();
|
||||
my $oauth_nonce = mknonce ();
|
||||
|
||||
my $oauth_signature = flickerSignReq (
|
||||
nojsoncallback => 1,
|
||||
oauth_nonce => $oauth_nonce,
|
||||
format => 'json',
|
||||
oauth_consumer_key => $flickr_consumer_key,
|
||||
oauth_timestamp => $oauth_timestamp,
|
||||
type => 'search_tags',
|
||||
content_type => 1,
|
||||
media => 'photos',
|
||||
method => 'flickr.photos.search',
|
||||
tags => $tags,
|
||||
per_page => 1,
|
||||
oauth_token => $flickr_access_token,
|
||||
oauth_token_secret => $flickr_access_token_secret,
|
||||
oauth_signature_method => 'HMAC-SHA1',
|
||||
oauth_version => '1.0'
|
||||
);
|
||||
|
||||
my $url = $flickr_api_url . sprintf (
|
||||
'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=1&tags=%s&tag_mode=all',
|
||||
$oauth_nonce,
|
||||
$flickr_consumer_key,
|
||||
$oauth_timestamp,
|
||||
$flickr_access_token,
|
||||
uri_encode ($oauth_signature),
|
||||
uri_encode ($tags)
|
||||
);
|
||||
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
my $r = $ua->get ($url)->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
my $response = eval {
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
if (defined $response) {
|
||||
# lets make another query, this time with random picture
|
||||
my $page = irand int ($response->{photos}->{total} / 500);
|
||||
$oauth_timestamp = time ();
|
||||
$oauth_nonce = mknonce ();
|
||||
$oauth_signature = flickerSignReq (
|
||||
nojsoncallback => 1,
|
||||
oauth_nonce => $oauth_nonce,
|
||||
format => 'json',
|
||||
oauth_consumer_key => $flickr_consumer_key,
|
||||
oauth_timestamp => $oauth_timestamp,
|
||||
type => 'search_text',
|
||||
content_type => 1,
|
||||
media => 'photos',
|
||||
method => 'flickr.photos.search',
|
||||
tags => $tags,
|
||||
page => $page,
|
||||
per_page => 500,
|
||||
oauth_token => $flickr_access_token,
|
||||
oauth_token_secret => $flickr_access_token_secret,
|
||||
oauth_signature_method => 'HMAC-SHA1',
|
||||
oauth_version => '1.0'
|
||||
);
|
||||
|
||||
$url = $flickr_api_url . sprintf (
|
||||
'?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=500&page=%d&tags=%s&tag_mode=all',
|
||||
$oauth_nonce,
|
||||
$flickr_consumer_key,
|
||||
$oauth_timestamp,
|
||||
$flickr_access_token,
|
||||
uri_encode ($oauth_signature),
|
||||
$page,
|
||||
uri_encode ($tags)
|
||||
);
|
||||
|
||||
$ua = Mojo::UserAgent->new->connect_timeout (5);
|
||||
$r = $ua->get ($url)->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
$response = eval {
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
if (defined $response) {
|
||||
return $response;
|
||||
} else {
|
||||
cluck "Flickr api returns incorrect json: $r->message";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Flickr api returns incorrect json: $r->message";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Flickr api returns incorrect json: $r->message";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "HTTP status code not 200: $r->code, $r->message";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub flickr_init {
|
||||
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) or do {
|
||||
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
}
|
||||
|
||||
tie my %secret, 'SQLite_File', $backingfile || do {
|
||||
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
|
||||
if (defined $flickr_verifier && $flickr_verifier) {
|
||||
my $flickr_request_token = $secret{flickr_request_token};
|
||||
my $flickr_request_token_secret = $secret{flickr_request_token_secret};
|
||||
|
||||
unless (defined $flickr_request_token || defined $flickr_request_token_secret) {
|
||||
say "Looks like there is no request token or request token secret in $backingfile"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
say 'Please remove verifier settings from config.json and run this script again'; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
untie %secret;
|
||||
return 0;
|
||||
}
|
||||
|
||||
my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier);
|
||||
|
||||
if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) {
|
||||
$secret{flickr_access_token} = $accessToken{oauth_token};
|
||||
$secret{flickr_access_token_secret} = $accessToken{oauth_token_secret};
|
||||
|
||||
say sprintf ( ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
'Access token (%s) and access token secret (%s) are in %s',
|
||||
$accessToken{oauth_token},
|
||||
$accessToken{oauth_token_secret},
|
||||
$backingfile
|
||||
);
|
||||
|
||||
untie %secret;
|
||||
return 1;
|
||||
}
|
||||
} else {
|
||||
my %req = flickrRequestToken ();
|
||||
if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) {
|
||||
$secret{flickr_request_token} = $req{oauth_token};
|
||||
$secret{flickr_request_token_secret} = $req{oauth_token_secret};
|
||||
my $confirm_url = flickrAuthorization ($req{oauth_token});
|
||||
|
||||
if (defined $confirm_url) {
|
||||
say "Please open this url in your browser and grant access for this app:\n$confirm_url"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
say 'Do not forget to put oauth_verifier to config.json file and re-run this script to get access token'; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
say 'Note that you should be logged off from flickr account.'; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
untie %secret;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
untie %secret;
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub flickr_test_login {
|
||||
my $text = shift;
|
||||
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) or do {
|
||||
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
}
|
||||
|
||||
tie my %secret, 'SQLite_File', $backingfile || do {
|
||||
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
|
||||
my $flickr_access_token = $secret{flickr_access_token};
|
||||
my $flickr_access_token_secret = $secret{flickr_access_token_secret};
|
||||
untie %secret;
|
||||
|
||||
if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub flickr_by_tags {
|
||||
my $text = shift;
|
||||
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) or do {
|
||||
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
}
|
||||
|
||||
tie my %secret, 'SQLite_File', $backingfile || do {
|
||||
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
|
||||
my $flickr_access_token = $secret{flickr_access_token};
|
||||
my $flickr_access_token_secret = $secret{flickr_access_token_secret};
|
||||
untie %secret;
|
||||
|
||||
# NB: I honestly query random page (among number of pages) of results from api, but always got first page,
|
||||
# no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate
|
||||
# this bug via query 500 results per page, then we can select random result in this heap. But anyway, let's
|
||||
# make this thing future proof and leave randomizer in page select.
|
||||
my $result = flickrSearchByTags ($flickr_access_token, $flickr_access_token_secret, $text);
|
||||
|
||||
if ($result) {
|
||||
if (defined ($result->{photos}) && defined ($result->{photos}->{photo})) {
|
||||
my $item = irand int(@{$result->{photos}->{photo}});
|
||||
$item = ${$result->{photos}->{photo}}[$item];
|
||||
$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
|
||||
return $item;
|
||||
} else {
|
||||
cluck 'Flickr api returns empty search result list';
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
sub flickr_by_text {
|
||||
my $text = shift;
|
||||
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) or do {
|
||||
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
}
|
||||
|
||||
tie my %secret, 'SQLite_File', $backingfile || do {
|
||||
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
|
||||
return 0;
|
||||
};
|
||||
|
||||
my $flickr_access_token = $secret{flickr_access_token};
|
||||
my $flickr_access_token_secret = $secret{flickr_access_token_secret};
|
||||
untie %secret;
|
||||
|
||||
# NB: I honestly query random page (among number of pages) of results from api, but always got first page,
|
||||
# no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate
|
||||
# this bug via query 500 results per page, then we can select random result in this heap. But anyway, let's
|
||||
# make this thing future proof and leave randomizer in page select.
|
||||
my $result = flickrSearchByText ($flickr_access_token, $flickr_access_token_secret, $text);
|
||||
|
||||
if ($result) {
|
||||
if (defined ($result->{photos}) && defined ($result->{photos}->{photo})) {
|
||||
my $item = irand int(@{$result->{photos}->{photo}});
|
||||
$item = ${$result->{photos}->{photo}}[$item];
|
||||
$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
|
||||
return $item;
|
||||
} else {
|
||||
cluck 'Flickr api returns empty search result list';
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
233
lib/image.pm
233
lib/image.pm
@@ -8,41 +8,39 @@ use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw (cluck);
|
||||
use File::Path qw (make_path);
|
||||
use JSON::XS;
|
||||
use HTTP::Tiny;
|
||||
use Math::Random::Secure qw (irand);
|
||||
use Mojo::UserAgent;
|
||||
use SQLite_File;
|
||||
use conf qw (loadConf);
|
||||
use flickr qw (flickr_by_tags);
|
||||
use imgur qw (imgur);
|
||||
use util qw (urlencode);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (kitty fox oboobs obutts rabbit);
|
||||
our @EXPORT_OK = qw (kitty fox oboobs obutts rabbit owl);
|
||||
|
||||
my $c = loadConf ();
|
||||
my $dir = $c->{image}->{dir};
|
||||
my $imgur_client_id = $c->{image}->{imgur}->{client_id};
|
||||
my $imgur_client_secret = $c->{image}->{imgur}->{client_secret};
|
||||
my $imgur_access_token = $c->{image}->{imgur}->{access_token};;
|
||||
my $imgur_refresh_token = $c->{image}->{imgur}->{refresh_token};
|
||||
|
||||
sub kitty {
|
||||
my $r;
|
||||
my $ret = 'Нету кошечек, все разбежались.';
|
||||
|
||||
for (1..3) {
|
||||
my $http = HTTP::Tiny->new (timeout => 3);
|
||||
$r = $http->get ('https://api.thecatapi.com/v1/images/search');
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||
$r = $ua->get ('https://api.thecatapi.com/v1/images/search')->result;
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
my $jcat = eval {
|
||||
decode_json ($r->{content})
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
unless (defined $jcat) {
|
||||
@@ -54,7 +52,7 @@ sub kitty {
|
||||
}
|
||||
}
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
@@ -65,19 +63,19 @@ sub fox {
|
||||
my $ret = 'Нету лисичек, все разбежались.';
|
||||
|
||||
for (1..3) {
|
||||
my $http = HTTP::Tiny->new (timeout => 3);
|
||||
$r = $http->get ('https://randomfox.ca/floof/');
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||
$r = $ua->get ('https://randomfox.ca/floof/')->result;
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
my $jfox = eval {
|
||||
decode_json ($r->{content})
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
unless (defined $jfox) {
|
||||
@@ -89,7 +87,7 @@ sub fox {
|
||||
}
|
||||
}
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
@@ -100,19 +98,19 @@ sub oboobs {
|
||||
my $ret = 'Нету cисичек, все разбежались.';
|
||||
|
||||
for (1..3) {
|
||||
my $http = HTTP::Tiny->new (timeout => 3);
|
||||
$r = $http->get ('http://api.oboobs.ru/boobs/0/1/random');
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||
$r = $ua->get ('http://api.oboobs.ru/boobs/0/1/random')->result;
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
my $joboobs = eval {
|
||||
decode_json ($r->{content})
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
unless (defined $joboobs) {
|
||||
@@ -124,7 +122,7 @@ sub oboobs {
|
||||
}
|
||||
}
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
@@ -135,19 +133,19 @@ sub obutts {
|
||||
my $ret = 'Нету попок, все разбежались.';
|
||||
|
||||
for (1..3) {
|
||||
my $http = HTTP::Tiny->new (timeout => 3);
|
||||
$r = $http->get ('http://api.obutts.ru/butts/0/1/random');
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||
$r = $ua->get ('http://api.obutts.ru/butts/0/1/random')->result;
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
if ($r->{success}) {
|
||||
if ($r->is_success) {
|
||||
my $jobutts = eval {
|
||||
decode_json ($r->{content})
|
||||
return $r->json;
|
||||
};
|
||||
|
||||
unless (defined $jobutts) {
|
||||
@@ -159,158 +157,26 @@ sub obutts {
|
||||
}
|
||||
}
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub imgur {
|
||||
my $tag = shift;
|
||||
|
||||
my $refresh_url = 'https://api.imgur.com/oauth2/token';
|
||||
my $search_url = 'https://api.imgur.com/3/gallery/search/';
|
||||
my $http = HTTP::Tiny->new (timeout => 5);
|
||||
|
||||
# load all tokens from api secrets db
|
||||
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) or do {
|
||||
cluck "Unable to create $dir: $OS_ERROR";
|
||||
return undef;
|
||||
};
|
||||
}
|
||||
|
||||
tie my %secret, 'SQLite_File', $backingfile || do {
|
||||
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
|
||||
return undef;
|
||||
};
|
||||
|
||||
# if there is no access_token in db - put there one from config
|
||||
if (defined $secret{imgur_access_token}) {
|
||||
$imgur_access_token = $secret{imgur_access_token};
|
||||
} else {
|
||||
$secret{imgur_access_token} = $imgur_access_token;
|
||||
}
|
||||
|
||||
# if there is no refresh_token in db - put there one from config
|
||||
if (defined $secret{imgur_refresh_token}) {
|
||||
$imgur_refresh_token = $secret{imgur_refresh_token};
|
||||
} else {
|
||||
$secret{imgur_refresh_token} = $imgur_refresh_token;
|
||||
}
|
||||
|
||||
# query api
|
||||
my $r = $http->get (
|
||||
$search_url . $tag,
|
||||
{
|
||||
headers => {
|
||||
Authorization => "Bearer $imgur_access_token"
|
||||
}
|
||||
}
|
||||
);
|
||||
|
||||
# looks like we need to refresh token
|
||||
if (($r->{status} == 401) || ($r->{status} == 403)) {
|
||||
$r = $http->post_form (
|
||||
$refresh_url,
|
||||
{
|
||||
refresh_token => $imgur_refresh_token,
|
||||
client_id => $imgur_client_id,
|
||||
clinent_secret => $imgur_client_secret,
|
||||
grant_type => 'refresh_token',
|
||||
}
|
||||
);
|
||||
|
||||
unless ($r->{success}) {
|
||||
cluck "Unable to refresh imgur token, please re-authorise app! or imgur experiencing api outage: $r->{status} $r->{content}";
|
||||
untie %secret;
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $refresh = eval { decode_json $r->{content} };
|
||||
|
||||
if (defined $refresh) {
|
||||
$imgur_refresh_token = $refresh->{refresh_token};
|
||||
$secret{imgur_refresh_token} = $refresh->{refresh_token};
|
||||
$imgur_access_token = $refresh->{access_token};
|
||||
$secret{imgur_access_token} = $refresh->{access_token};
|
||||
} else {
|
||||
cluck "Unable to refresh imgur access_token, unable to decode json: $EVAL_ERROR";
|
||||
untie %secret;
|
||||
return undef;
|
||||
}
|
||||
|
||||
# query api again
|
||||
$r = $http->get (
|
||||
$search_url . $tag,
|
||||
{
|
||||
headers => {
|
||||
Authorization => "Bearer $imgur_access_token"
|
||||
}
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
untie %secret;
|
||||
|
||||
if ($r->{success}) {
|
||||
my $searchResult = eval { decode_json ($r->{content}) };
|
||||
my @urls;
|
||||
|
||||
if (defined $searchResult) {
|
||||
if ($searchResult->{success}) {
|
||||
foreach my $item (@{$searchResult->{data}}) {
|
||||
foreach my $image (@{$item->{images}}) {
|
||||
if (defined ($image->{animated}) && (0 + $image->{animated}) != 0) {
|
||||
next;
|
||||
}
|
||||
|
||||
if (($image->{type} eq 'image/jpeg') || ($image->{type} eq 'image/png')) {
|
||||
if (defined ($image->{is_ad}) && (0 + $image->{is_ad}) !=0) {
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined ($image->{nsfw}) && (0 + $image->{nsfw}) != 0) {
|
||||
next;
|
||||
}
|
||||
|
||||
push @urls, $image->{link};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($#urls > 0) {
|
||||
return $urls[irand ($#urls + 1)];
|
||||
} else {
|
||||
cluck 'Imgur api returned empty result.';
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Unable to get results from imgur api: $r->{content}";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Unable to decode imgur api json: $EVAL_ERROR";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Unable to get results from imgur api: $r->{status}, $r->{content}";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub rabbit {
|
||||
# It works but results are not particulary relevant, partially. about 20-30% miss
|
||||
# So i prefer to use flickr rabbits selection :)
|
||||
sub rabbit_imgur {
|
||||
my @terms = (
|
||||
'?q=animals%20AND%20%28%20rabbits%20OR%20bunnies%20%29',
|
||||
'year?q=animals%20AND%20%28%20rabbits%20OR%20bunnies%20%29',
|
||||
'relevance?q=animals+AND+%28+rabbits+OR+bunnies+%29',
|
||||
'relevance/year?q=animals+AND+%28+rabbits+OR+bunnies+%29',
|
||||
'score?q_not=cat%20OR%20kitten%20OR%20kittens%20OR%20dog%20OR%20cats%20OR%20dogs%20OR%20puppy%20OR%20puppies&q_tags=bunnies%2Cbunny%2Crabbits%2Crabbit'
|
||||
urlencode '?q=animals AND (rabbits OR bunnies)',
|
||||
urlencode 'year?q=animals AND (rabbits OR bunnies)',
|
||||
urlencode 'relevance?q=animals AND (rabbits OR bunnies)',
|
||||
urlencode 'relevance/year?q=animals AND (rabbits OR bunnies)',
|
||||
urlencode 'score?q_not=cat OR kitten OR kittens OR dog OR cats OR dogs OR puppy OR puppies&q_tags=bunnies,bunny,rabbits,rabbit',
|
||||
);
|
||||
|
||||
my $rabbit = imgur ($terms[irand ($#terms + 1)]);
|
||||
# return just large thumbnail instead of real photo (that can be really huge)
|
||||
$rabbit = sprintf '%sl%s', substr ($rabbit, 0, -4), substr ($rabbit, -4);
|
||||
|
||||
if (defined $rabbit) {
|
||||
return sprintf '[(\_/)](%s)', $rabbit;
|
||||
@@ -319,6 +185,27 @@ sub rabbit {
|
||||
}
|
||||
}
|
||||
|
||||
sub rabbit {
|
||||
# rabbit, but bunny
|
||||
my $url = flickr_by_tags ('animal,bunny');
|
||||
|
||||
if (defined $url) {
|
||||
return sprintf '[(\_/)](%s)', $url;
|
||||
} else {
|
||||
return 'Нету кроликов, все разбежались.';
|
||||
}
|
||||
}
|
||||
|
||||
sub owl {
|
||||
my $url = flickr_by_tags ('bird,owl');
|
||||
|
||||
if (defined $url) {
|
||||
return sprintf '[{ O v O }](%s)', $url;
|
||||
} else {
|
||||
return 'Нету сов, все разлетелись.';
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
|
||||
148
lib/imgur.pm
Normal file
148
lib/imgur.pm
Normal file
@@ -0,0 +1,148 @@
|
||||
package imgur;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw (cluck);
|
||||
use File::Path qw (make_path);
|
||||
use Math::Random::Secure qw (irand);
|
||||
use Mojo::UserAgent;
|
||||
use SQLite_File;
|
||||
use conf qw (loadConf);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (imgur);
|
||||
|
||||
my $c = loadConf ();
|
||||
my $dir = $c->{image}->{dir};
|
||||
my $imgur_client_id = $c->{image}->{imgur}->{client_id};
|
||||
my $imgur_client_secret = $c->{image}->{imgur}->{client_secret};
|
||||
my $imgur_access_token = $c->{image}->{imgur}->{access_token};;
|
||||
my $imgur_refresh_token = $c->{image}->{imgur}->{refresh_token};
|
||||
|
||||
sub imgur {
|
||||
my $tag = shift;
|
||||
|
||||
my $refresh_url = 'https://api.imgur.com/oauth2/token';
|
||||
my $search_url = 'https://api.imgur.com/3/gallery/search/';
|
||||
|
||||
# load all tokens from api secrets db
|
||||
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path ($dir) or do {
|
||||
cluck "Unable to create $dir: $OS_ERROR";
|
||||
return undef;
|
||||
};
|
||||
}
|
||||
|
||||
tie my %secret, 'SQLite_File', $backingfile || do {
|
||||
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
|
||||
return undef;
|
||||
};
|
||||
|
||||
# if there is no access_token in db - put there one from config
|
||||
if (defined $secret{imgur_access_token}) {
|
||||
$imgur_access_token = $secret{imgur_access_token};
|
||||
} else {
|
||||
$secret{imgur_access_token} = $imgur_access_token;
|
||||
}
|
||||
|
||||
# if there is no refresh_token in db - put there one from config
|
||||
if (defined $secret{imgur_refresh_token}) {
|
||||
$imgur_refresh_token = $secret{imgur_refresh_token};
|
||||
} else {
|
||||
$secret{imgur_refresh_token} = $imgur_refresh_token;
|
||||
}
|
||||
|
||||
# query api
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||
my $r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
|
||||
|
||||
# looks like we need to refresh token
|
||||
if (($r->code == 401) || ($r->code == 403)) {
|
||||
$ua->post (
|
||||
$refresh_url => form {
|
||||
refresh_token => $imgur_refresh_token,
|
||||
client_id => $imgur_client_id,
|
||||
clinent_secret => $imgur_client_secret,
|
||||
grant_type => 'refresh_token',
|
||||
}
|
||||
);
|
||||
|
||||
unless ($r->is_success) {
|
||||
cluck "Unable to refresh imgur token, please re-authorise app! or imgur experiencing api outage: $r->code $r->message";
|
||||
untie %secret;
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $refresh = eval { return $r->json; };
|
||||
|
||||
if (defined $refresh) {
|
||||
$imgur_refresh_token = $refresh->{refresh_token};
|
||||
$secret{imgur_refresh_token} = $refresh->{refresh_token};
|
||||
$imgur_access_token = $refresh->{access_token};
|
||||
$secret{imgur_access_token} = $refresh->{access_token};
|
||||
} else {
|
||||
cluck "Unable to refresh imgur access_token, unable to decode json: $EVAL_ERROR";
|
||||
untie %secret;
|
||||
return undef;
|
||||
}
|
||||
|
||||
# query api again
|
||||
$r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
|
||||
}
|
||||
|
||||
untie %secret;
|
||||
|
||||
if ($r->is_success) {
|
||||
my $searchResult = eval { return $r->json; };
|
||||
my @urls;
|
||||
|
||||
if (defined $searchResult) {
|
||||
if ($searchResult->{success}) {
|
||||
foreach my $item (@{$searchResult->{data}}) {
|
||||
foreach my $image (@{$item->{images}}) {
|
||||
if (defined ($image->{animated}) && (0 + $image->{animated}) != 0) {
|
||||
next;
|
||||
}
|
||||
|
||||
if (($image->{type} eq 'image/jpeg') || ($image->{type} eq 'image/png')) {
|
||||
if (defined ($image->{is_ad}) && (0 + $image->{is_ad}) !=0) {
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined ($image->{nsfw}) && (0 + $image->{nsfw}) != 0) {
|
||||
next;
|
||||
}
|
||||
|
||||
push @urls, $image->{link};
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($#urls > 0) {
|
||||
return $urls[irand ($#urls + 1)];
|
||||
} else {
|
||||
cluck 'Imgur api returned empty result.';
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Unable to get results from imgur api: $r->message";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Unable to decode imgur api json: $EVAL_ERROR";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
cluck "Unable to get results from imgur api: $r->code, $r->message";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
62
lib/monkeyuser.pm
Normal file
62
lib/monkeyuser.pm
Normal file
@@ -0,0 +1,62 @@
|
||||
package monkeyuser;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw (cluck);
|
||||
use HTML::TokeParser;
|
||||
use Math::Random::Secure qw (irand);
|
||||
use Mojo::UserAgent;
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (monkeyuser);
|
||||
|
||||
sub monkeyuser {
|
||||
my $r;
|
||||
my $ret = 'Нету Monkey User-ов, они все спрятались.';
|
||||
my @link;
|
||||
|
||||
for (1..3) {
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (3);
|
||||
$r = $ua->get ('https://www.monkeyuser.com/toc/')->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
if ($r->is_success) {
|
||||
my $p = HTML::TokeParser->new(\$r->body);
|
||||
my @a;
|
||||
|
||||
do {
|
||||
$#a = -1;
|
||||
@a = $p->get_tag('a'); ## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
|
||||
if (defined $a[0][1]->{class} && $a[0][1]->{class} eq 'lazyload small-image') {
|
||||
if (defined $a[0][1]->{'data-src'} && ($a[0][1]->{'data-src'} !~ /adlitteram/)) {
|
||||
push @link, $a[0][1]->{'data-src'};
|
||||
}
|
||||
}
|
||||
|
||||
} while ($#{$a[0]} > 1);
|
||||
|
||||
if ($#link > 0) {
|
||||
$ret = sprintf '[MonkeyUser](https://www.monkeyuser.com%s)', $link [irand (1 + $#link)];
|
||||
}
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
108
lib/weather.pm
108
lib/weather.pm
@@ -7,11 +7,13 @@ use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw (carp cluck);
|
||||
use CHI;
|
||||
use CHI::Driver::BerkeleyDB;
|
||||
use DB_File;
|
||||
use Digest::MD5 qw (md5_base64);
|
||||
use File::Path qw (make_path);
|
||||
use HTTP::Tiny;
|
||||
use JSON::XS;
|
||||
use Mojo::Log;
|
||||
use Mojo::UserAgent::Cached;
|
||||
use conf qw (loadConf);
|
||||
use util qw (trim urlencode);
|
||||
|
||||
@@ -34,7 +36,8 @@ sub weather {
|
||||
|
||||
if ($w) {
|
||||
if ($w->{temperature_min} == $w->{temperature_max}) {
|
||||
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
|
||||
$reply = sprintf (
|
||||
"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
|
||||
$w->{name},
|
||||
$w->{country},
|
||||
ucfirst $w->{description},
|
||||
@@ -46,7 +49,8 @@ sub weather {
|
||||
$w->{pressure}
|
||||
);
|
||||
} else {
|
||||
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
|
||||
$reply = sprintf (
|
||||
"Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
|
||||
$w->{name},
|
||||
$w->{country},
|
||||
ucfirst $w->{description},
|
||||
@@ -69,77 +73,53 @@ sub weather {
|
||||
sub __weather {
|
||||
my $city = shift;
|
||||
$city = urlencode $city;
|
||||
my $id = md5_base64 $city;
|
||||
my $appid = $c->{openweathermap}->{appid};
|
||||
my $cachedir = $c->{openweathermap}->{cachedir};
|
||||
my $cachetimefile = $cachedir . '/openweathermap.Id-Timestamp.db';
|
||||
my $cachedatafile = $cachedir . '/openweathermap.Id-Data.db';
|
||||
my $now = time ();
|
||||
my $fc;
|
||||
my $w;
|
||||
|
||||
unless (-d $cachedir) {
|
||||
make_path ($cachedir) || do {
|
||||
cluck "[ERROR] Unable to create $cachedir: $OS_ERROR";
|
||||
return;
|
||||
my $r;
|
||||
|
||||
# try 3 times and giveup
|
||||
for (1..3) {
|
||||
my $ua = Mojo::UserAgent::Cached->new;
|
||||
$ua->local_dir ($cachedir);
|
||||
$ua->cache_agent(
|
||||
CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__,
|
||||
expires_in => '3 hours',
|
||||
expires_on_backend => 1,
|
||||
)
|
||||
);
|
||||
# just to make Mojo::UserAgent::Cached happy
|
||||
$ua->logger (Mojo::Log->new (path => '/dev/null', level => 'error'));
|
||||
$r = $ua->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid))->result;
|
||||
|
||||
if ($r->is_success) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
# all 3 times can give error, so check it here
|
||||
if ($r->is_success) {
|
||||
$fc = eval {
|
||||
return $r->json;
|
||||
};
|
||||
}
|
||||
|
||||
# attach to cache data
|
||||
tie my %cachetime, 'DB_File', $cachetimefile or do {
|
||||
carp "[ERROR] Something nasty happen when cachetime ties to its data: $OS_ERROR";
|
||||
return undef;
|
||||
};
|
||||
|
||||
tie my %cachedata, 'DB_File', $cachedatafile or do {
|
||||
carp "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
|
||||
return undef;
|
||||
};
|
||||
|
||||
# lookup cache
|
||||
if (defined ($cachetime{$id}) && ($now - $cachetime{$id}) < 10800) {
|
||||
$fc = decode_json $cachedata{$id};
|
||||
} else {
|
||||
my $r;
|
||||
|
||||
# try 3 times and giveup
|
||||
for (1..3) {
|
||||
my $http = HTTP::Tiny->new (timeout => 3);
|
||||
$r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid));
|
||||
|
||||
if ($r->{success}) {
|
||||
last;
|
||||
}
|
||||
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
# all 3 times can give error, so check it here
|
||||
if ($r->{success}) {
|
||||
$fc = eval {
|
||||
decode_json $r->{content};
|
||||
};
|
||||
|
||||
if ($EVAL_ERROR) {
|
||||
cluck "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
|
||||
untie %cachetime;
|
||||
untie %cachedata;
|
||||
return undef;
|
||||
};
|
||||
|
||||
$cachetime{$id} = $now;
|
||||
$cachedata{$id} = encode_json $fc;
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
|
||||
untie %cachetime;
|
||||
untie %cachedata;
|
||||
unless ($fc) {
|
||||
cluck "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
|
||||
return undef;
|
||||
}
|
||||
};
|
||||
} else {
|
||||
cluck sprintf 'Server return status %s with message: %s', $r->code, $r->message;
|
||||
return undef;
|
||||
}
|
||||
|
||||
untie %cachetime;
|
||||
untie %cachedata;
|
||||
|
||||
# TODO: check all of this for existence
|
||||
$w->{'name'} = $fc->{name};
|
||||
$w->{'state'} = $fc->{state};
|
||||
|
||||
32
lib/xkcd.pm
Normal file
32
lib/xkcd.pm
Normal file
@@ -0,0 +1,32 @@
|
||||
package xkcd;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use Mojo::UserAgent;
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (xkcd);
|
||||
|
||||
sub xkcd {
|
||||
my $ua = Mojo::UserAgent->new->connect_timeout (5)->max_redirects (0);
|
||||
my $r = $ua->get ('https://xkcd.ru/random/')->result;
|
||||
|
||||
if (
|
||||
defined $r->content &&
|
||||
defined $r->content->headers &&
|
||||
defined $r->content->headers->location &&
|
||||
$r->content->headers->location ne ''
|
||||
) {
|
||||
return sprintf '[xkcd.ru](https://xkcd.ru/i/%s_v1.png)', substr ($r->content->headers->location, 1, -1);
|
||||
}
|
||||
|
||||
return 'Комикс-стрип нарисовать не так-то просто :(';
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
Reference in New Issue
Block a user