1

Compare commits

9 Commits

23 changed files with 1169 additions and 223 deletions

103
README_RU.md Normal file
View 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/

View File

@@ -1,5 +1,8 @@
requires 'Carp';
requires 'CHI';
requires 'CHI::Driver::BerkeleyDB';
requires 'Cwd::utf8';
requires 'DateTime';
requires 'DB_File';
requires 'SQLite_File';
requires 'Digest::HMAC_SHA1';
@@ -10,7 +13,6 @@ requires 'File::Basename';
requires 'File::Path';
requires 'Hailo';
requires 'HTML::TokeParser';
requires 'HTTP::Tiny';
requires 'IO::Socket::SSL';
requires 'JSON';
requires 'JSON::XS';
@@ -23,6 +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';

View File

@@ -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

View File

@@ -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/],
};
}

View File

@@ -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;
}

View 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

View File

@@ -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/],
};
}

View 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

View File

@@ -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/],
};
}

View 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

View File

@@ -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/]
};
}

View 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

View 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

View 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

View File

@@ -14,12 +14,14 @@ 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 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);
@@ -164,6 +166,10 @@ sub command {
$reply = sprintf "```\n%s\n```\n", trim (fortune ());
$msg->replyMd ($reply);
return;
} 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;
@@ -184,6 +190,7 @@ ${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

View File

@@ -7,8 +7,8 @@ use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck);
use HTTP::Tiny;
use HTML::TokeParser;
use Mojo::UserAgent;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
@@ -19,25 +19,25 @@ sub buni {
my $ret = 'Нету Buni';
for (1..3) {
my $http = HTTP::Tiny->new (timeout => 3);
$r = $http->get ('http://www.bunicomic.com/?random&nocache=1');
my $ua = Mojo::UserAgent->new->connect_timeout (3);
$r = $ua->get ('http://www.bunicomic.com/?random&nocache=1')->result;
if ($r->{success}) {
if ($r->is_success) {
last;
}
sleep 2;
}
if ($r->{success}) {
my $p = HTML::TokeParser->new(\$r->{content});
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");
@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};
@@ -47,7 +47,7 @@ sub buni {
} while ($#{$a[0]} > 1);
}
} 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;

111
lib/drink.pm Normal file
View 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:

View File

@@ -9,10 +9,9 @@ use English qw ( -no_match_vars );
use Carp qw (cluck);
use Digest::HMAC_SHA1 qw (hmac_sha1);
use File::Path qw (make_path);
use JSON::XS;
use HTTP::Tiny;
use Math::Random::Secure qw (irand);
use MIME::Base64;
use Mojo::UserAgent;
use SQLite_File;
use URI::Encode::XS qw (uri_encode);
@@ -120,15 +119,15 @@ sub flickrRequestToken {
uri_encode ($flickr_callback_url)
);
my $http = HTTP::Tiny->new (timeout => 5);
my $r = $http->get ($url);
my $ua = Mojo::UserAgent->new->connect_timeout (5);
my $r = $ua->get ($url)->result;
my %params;
if ($r->{success}) {
if ($r->is_success) {
# they ignore format=json, so...
%params = map {split /=/} split /&/, $r->{content};
%params = map {split /=/} split /&/, $r->body;
} else {
say "Something bad returns from flickr api: $r->{status} $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls)
say "Something bad returns from flickr api: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
}
return %params;
@@ -161,15 +160,15 @@ sub flickrAccessToken {
uri_encode ($oauth_signature)
);
my $http = HTTP::Tiny->new (timeout => 5);
my $r = $http->get ($url);
my $ua = Mojo::UserAgent->new->connect_timeout (5);
my $r = $ua->get ($url)->result;
my %params;
if ($r->{success}) {
if ($r->is_success) {
# they ignore format=json
%params = map {split /=/} split /&/, $r->{content};
%params = map {split /=/} split /&/, $r->body;
} else {
say "Something bad returns from flickr api: $r->{status} $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls)
say "Something bad returns from flickr api: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
}
return %params;
@@ -183,13 +182,13 @@ sub flickrAuthorization {
$flickr_request_token,
);
my $http = HTTP::Tiny->new (timeout => 5);
my $r = $http->get ($url);
my $ua = Mojo::UserAgent->new->connect_timeout (5);
my $r = $ua->get ($url)->result;
if ($r->{success}) {
return $r->{url};
if ($r->is_success) {
return $r->url;
} else {
say "Something went wrong: $r->{status} $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls)
say "Something went wrong: $r->code $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
return;
}
}
@@ -224,24 +223,23 @@ sub flickrTestLogin {
uri_encode ($oauth_signature)
);
my $http = HTTP::Tiny->new (timeout => 5);
my $r = $http->get ($url);
my $ua = Mojo::UserAgent->new->connect_timeout (5);
my $r = $ua->get ($url)->result;
if ($r->{success}) {
if ($r->is_success) {
my $response = eval {
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($r->{content});
return $r->json;
};
if (defined $response) {
say Dumper $response; ## no critic (InputOutput::RequireCheckedSyscalls)
return 1;
} else {
say "Flickr api returns incorrect json: $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls)
say "Flickr api returns incorrect json: $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
return 0;
}
} else {
say "HTTP status code not 200: $r->{status}, $r>{contenr}"; ## no critic (InputOutput::RequireCheckedSyscalls)
say "HTTP status code not 200: $r->code, $r->message"; ## no critic (InputOutput::RequireCheckedSyscalls)
return 0;
}
}
@@ -282,13 +280,12 @@ sub flickrSearchByText {
uri_encode ($text)
);
my $http = HTTP::Tiny->new (timeout => 5);
my $r = $http->get ($url);
my $ua = Mojo::UserAgent->new->connect_timeout (5);
my $r = $ua->get ($url)->result;
if ($r->{success}) {
if ($r->is_success) {
my $response = eval {
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($r->{content});
return $r->json;
};
if (defined $response) {
@@ -326,31 +323,31 @@ sub flickrSearchByText {
uri_encode ($text)
);
$http = HTTP::Tiny->new (timeout => 5);
$r = $http->get ($url);
$ua = Mojo::UserAgent->new->connect_timeout (5);
$r = $ua->get ($url)->result;
if ($r->{success}) {
if ($r->is_success) {
$response = eval {
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($r->{content});
return $r->json;
};
if (defined $response) {
return $response;
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
cluck "Flickr api returns incorrect json: $r->message";
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
cluck "Flickr api returns incorrect json: $r->message";
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
cluck "Flickr api returns incorrect json: $r->message";
return undef;
}
} else {
cluck "HTTP status code not 200: $r->{status}, $r->{content}";
cluck "HTTP status code not 200: $r->code, $r->message";
return undef;
}
}
@@ -391,13 +388,12 @@ sub flickrSearchByTags {
uri_encode ($tags)
);
my $http = HTTP::Tiny->new (timeout => 5);
my $r = $http->get ($url);
my $ua = Mojo::UserAgent->new->connect_timeout (5);
my $r = $ua->get ($url)->result;
if ($r->{success}) {
if ($r->is_success) {
my $response = eval {
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($r->{content});
return $r->json;
};
if (defined $response) {
@@ -435,31 +431,30 @@ sub flickrSearchByTags {
uri_encode ($tags)
);
$http = HTTP::Tiny->new (timeout => 5);
$r = $http->get ($url);
$ua = Mojo::UserAgent->new->connect_timeout (5);
$r = $ua->get ($url)->result;
if ($r->{success}) {
if ($r->is_success) {
$response = eval {
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($r->{content});
return $r->json;
};
if (defined $response) {
return $response;
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
cluck "Flickr api returns incorrect json: $r->message";
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
cluck "Flickr api returns incorrect json: $r->message";
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
cluck "Flickr api returns incorrect json: $r->message";
return undef;
}
} else {
cluck "HTTP status code not 200: $r->{status}, $r>{contenr}";
cluck "HTTP status code not 200: $r->code, $r->message";
return undef;
}
}
@@ -484,8 +479,8 @@ sub flickr_init {
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";
say "Please remove verifier settings from config.json and run this script again";
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;
}

View File

@@ -8,9 +8,8 @@ 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);
@@ -29,19 +28,19 @@ sub kitty {
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) {
@@ -53,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;
@@ -64,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) {
@@ -88,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;
@@ -99,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) {
@@ -123,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;
@@ -134,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) {
@@ -158,7 +157,7 @@ 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;

View File

@@ -8,9 +8,8 @@ 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);
@@ -30,7 +29,6 @@ sub imgur {
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;
@@ -62,20 +60,13 @@ sub imgur {
}
# query api
my $r = $http->get (
$search_url . $tag,
{
headers => {
Authorization => "Bearer $imgur_access_token"
}
}
);
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->{status} == 401) || ($r->{status} == 403)) {
$r = $http->post_form (
$refresh_url,
{
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,
@@ -83,13 +74,13 @@ sub imgur {
}
);
unless ($r->{success}) {
cluck "Unable to refresh imgur token, please re-authorise app! or imgur experiencing api outage: $r->{status} $r->{content}";
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 { decode_json $r->{content} };
my $refresh = eval { return $r->json; };
if (defined $refresh) {
$imgur_refresh_token = $refresh->{refresh_token};
@@ -103,20 +94,13 @@ sub imgur {
}
# query api again
$r = $http->get (
$search_url . $tag,
{
headers => {
Authorization => "Bearer $imgur_access_token"
}
}
);
$r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
}
untie %secret;
if ($r->{success}) {
my $searchResult = eval { decode_json ($r->{content}) };
if ($r->is_success) {
my $searchResult = eval { return $r->json; };
my @urls;
if (defined $searchResult) {
@@ -148,7 +132,7 @@ sub imgur {
return undef;
}
} else {
cluck "Unable to get results from imgur api: $r->{content}";
cluck "Unable to get results from imgur api: $r->message";
return undef;
}
} else {
@@ -156,7 +140,7 @@ sub imgur {
return undef;
}
} else {
cluck "Unable to get results from imgur api: $r->{status}, $r->{content}";
cluck "Unable to get results from imgur api: $r->code, $r->message";
return undef;
}
}

View File

@@ -7,9 +7,9 @@ use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck);
use HTTP::Tiny;
use HTML::TokeParser;
use Math::Random::Secure qw (irand);
use Mojo::UserAgent;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
@@ -21,27 +21,27 @@ sub monkeyuser {
my @link;
for (1..3) {
my $http = HTTP::Tiny->new (timeout => 3);
$r = $http->get ('https://www.monkeyuser.com/toc/');
my $ua = Mojo::UserAgent->new->connect_timeout (3);
$r = $ua->get ('https://www.monkeyuser.com/toc/')->result;
if ($r->{success}) {
if ($r->is_success) {
last;
}
sleep 2;
}
if ($r->{success}) {
my $p = HTML::TokeParser->new(\$r->{content});
if ($r->is_success) {
my $p = HTML::TokeParser->new(\$r->body);
my @a;
do {
$#a = -1;
@a = $p->get_tag("a");
@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"};
if (defined $a[0][1]->{'data-src'} && ($a[0][1]->{'data-src'} !~ /adlitteram/)) {
push @link, $a[0][1]->{'data-src'};
}
}

View File

@@ -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};

View File

@@ -5,18 +5,23 @@ use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use HTTP::Tiny;
use Mojo::UserAgent;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (xkcd);
sub xkcd {
my $http = HTTP::Tiny->new (timeout => 5, max_redirect => 0);
my $r = $http->get ('https://xkcd.ru/random/');
my $ua = Mojo::UserAgent->new->connect_timeout (5)->max_redirects (0);
my $r = $ua->get ('https://xkcd.ru/random/')->result;
if (defined $r->{headers} && defined $r->{headers}->{location} && $r->{headers}->{location} ne '') {
return sprintf '[xkcd.ru](https://xkcd.ru/i/%s_v1.png)', substr ($r->{headers}->{location}, 1, -1);
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 'Комикс-стрип нарисовать не так-то просто :(';