1

174 Commits

Author SHA1 Message Date
eleksir
e135ef7d7c Deejay redis subs to RedisLib.pm, translate comments, small fixes 2022-01-28 20:11:00 +03:00
eleksir
731d707baa Remove duplicate code 2022-01-28 17:43:54 +03:00
eleksir
6840e6d5d0 Update README.md && README_RU.md 2022-01-28 17:32:31 +03:00
eleksir
ba14f6e619 Use all types of greet phrases to omit answer if newcommer respond to our greet with quotation 2022-01-28 17:21:16 +03:00
eleksir
00a82dd2cd Braindir with brains themselves moved to aleesa-craniac application 2022-01-28 16:27:28 +03:00
eleksir
6554879b19 In newcommer greeting treat space-char-only first_name or last_name as non-existing 2022-01-28 16:25:10 +03:00
eleksir
9a5b899a42 Fix coding style 2022-01-28 16:22:06 +03:00
eleksir
3a061078d4 Move Archeologist and Fisher to separate module 2022-01-08 02:43:37 +03:00
eleksir
ca946c7e7b Move web client and karma plugins to redis rails, remove unneeded data and perl modules 2022-01-06 04:13:38 +03:00
eleksir
c68f716cbb Try to move most of static commands to redis rails 2022-01-01 02:00:43 +03:00
eleksir
31e077c219 Add easter egg phrases in private and group conversations, fix previous addition of private phrases a bit 2021-12-25 15:44:36 +03:00
eleksir
ae553d8aa5 Update version in help message 2021-12-20 00:04:13 +03:00
eleksir
1d287f853f Move !ping to redis rails 2021-12-19 20:39:03 +03:00
eleksir
e74a3e46c1 Use main:: namespace to preserve telegram and redis context 2021-12-19 13:54:28 +03:00
eleksir
186b112eba Merge branch 'master' into redis 2021-12-19 12:19:01 +03:00
eleksir
f223ba04ae Extend weather command list, add !weather, !погода, !погадка, !погодка, also allow oboobs and obutts plugins in private conversation 2021-12-18 17:24:21 +03:00
eleksir
17bd260a45 Export proper function name in RedisLib.pm, fix typo in Cli.pm 2021-12-11 16:00:21 +03:00
eleksir
7cac72d5b9 Fixes for cli
Use correct path for working dir
Fix path for Conf.om
Use pubsub object instead of redis connection
2021-12-11 15:55:14 +03:00
eleksir
f33e05a91c Add test client for redis 2021-12-11 15:38:58 +03:00
eleksir
ab89105168 Add initial redis support 2021-12-11 13:57:23 +03:00
eleksir
8d35bb2452 Update api with fields from v5.4 and v5.5 2021-12-07 20:11:56 +03:00
eleksir
71a2471725 Couple of grammar and coding style mistakes fixes here and there 2021-12-04 03:10:41 +03:00
eleksir
e93c9f9131 Use different hello-phrases to greet newcommers 2021-12-03 20:25:51 +03:00
eleksir
1abb95622a Fix bunch of grammar mistakes 2021-10-17 01:14:38 +03:00
eleksir
bb399a5051 Add undocumented commands !kde and !кде 2021-10-12 10:54:30 +03:00
eleksir
c5014a8f77 Weather.pm: Hardcode popular russian short city names 2021-10-01 13:23:00 +03:00
eleksir
f83a2d3436 Anek.pm: fix rare case when fetched response is unparsable 2021-08-16 00:03:38 +03:00
eleksir
2134edd841 Implemented !proverb and !пословица commands 2021-08-11 16:54:21 +03:00
eleksir
3dd565c658 Implemented !coin !монетка !roll !dies !кости commands 2021-08-11 13:19:56 +03:00
eleksir
7147b785e7 Add !anek !анек !анекдот commands 2021-07-29 21:26:59 +03:00
eleksir
f1ad32d5ae Add migration scripts and doc.
When I move bot from perl-5.30.0 to perl-5.32.1 I encounter with BDB0091
DB_VERSION_MISMATCH error And it looks like I have to export essential
data on older perl to some portable format and then import it on newer
perl environment.
2021-07-05 16:56:01 +03:00
eleksir
66f64da5c6 Fix incorrect error message when unable to create gamestatdir 2021-07-05 13:54:27 +03:00
eleksir
cf71cd7f6f Apply perlcritic 2021-07-03 11:20:13 +03:00
eleksir
eddbcc6277 Prep for gamestat implementation
* Move artifacts to separate files
+ Implement db seed with artifacts
+ Add gamedata_seed.pl script to seed artifacts to db
2021-07-02 16:03:20 +03:00
eleksir
30fb568de0 Use "от ... до ..." instead of simple dash in Weather.pm 2021-06-28 11:01:40 +03:00
eleksir
9c9e67e0a2 Enhance Weather.pm
- Fix incomplete message when t.min==t.max
- Print t.max - t.min if both of them are < 0
2021-06-28 10:50:53 +03:00
eleksir
47e82449e7 Update present api implementation to botapi v5.3 2021-06-26 10:00:51 +03:00
eleksir
b6ec09c5de Now bot triggers on phrase "кто все эти люди?" correctly even if it mentioned first 2021-06-24 01:21:51 +03:00
eleksir
dca58a3deb Add undocumented voice field to ChatMemberUpdated object 2021-06-12 14:09:40 +03:00
eleksir
6d439a1b44 Implement !horse !лошадка !frog !лягушка !snail !улитка commands 2021-05-06 11:00:44 +03:00
eleksir
096877bee2 Make logging use features of Log::Any and log as it should be done via this module. Cleanup sample config. 2021-05-04 18:45:30 +03:00
eleksir
095cb57a18 Implemented !хелп, !хэлп, answer 'кто все эти люди?' question, hide notext log message to debug lever 2021-05-04 13:30:11 +03:00
eleksir
36c79eb46c Add BotLib changes to all remain scripts in bin dir 2021-05-01 01:29:02 +03:00
eleksir
dd693bf5fb Update Flickr API registration procedure in README_RU.md 2021-05-01 01:08:41 +03:00
eleksir
b8c3f4957c Update objects of Teapot::Bot according Bot API docs. Add missing fields.
+ Add missing fields some of existing objects
* Fix copy-paste errors in Teapot::Bot::Object::PollAnswer
2021-05-01 01:05:31 +03:00
eleksir
ec6c63a954 Add 'text' field to ChatMemberUpdated, looks like they miss to document it 2021-04-30 23:53:51 +03:00
eleksir
62650bd8ad Update to api 5.2 changes (no payments-2.0) 2021-04-30 23:42:54 +03:00
eleksir
8d5b5df194 FortuneToggleList() was misspelled in periodic job so fortune message was not shown 2021-04-26 11:06:16 +03:00
eleksir
0befdf6327 Set log verbosity of CHI::Driver to warn to avoid excessive logging flood 2021-04-25 01:50:01 +03:00
eleksir
8e2414288b Fix some errors of tg api v5.1 transition 2021-04-25 01:34:58 +03:00
eleksir
fbab0a4d88 1-st run fixes after refactor 2021-04-24 16:12:30 +03:00
eleksir
a3f8b43f07 Merge branch 'master' into chi 2021-04-24 11:53:26 +03:00
eleksir
615213ee41 Merge branch 'master' into update_teapot_bot_lib_to_api_v5.1 2021-04-24 11:47:44 +03:00
eleksir
e7ef39366b Try not to die inside Mojo::Reactor::Poll if some incorrect data lands in update 2021-04-22 19:24:59 +03:00
eleksir
3c721b905f Sometimes xkcd.ru returns redirect to 404, retry to get correct content in this case. 2021-04-22 19:02:08 +03:00
eleksir
8665a6ddda Refactor some parts of bot
- Move most modules to subdirs
- Rename functions according perlcritic guidelines
- Fix and add some bugs
2021-04-22 17:36:50 +03:00
eleksir
f7634a26d1 Add README_RU.md 2021-04-21 14:58:17 +03:00
eleksir
729489236f move admin to CHI 2021-04-07 13:43:34 +03:00
eleksir
cec3ed66fb Introduce cachedir config pragma, move karma to CHI
* Move karma from homebrew storage to CHI
* Use cachedir for CHI file storage heap
* Use cachedir in drink.pm
* Use cachedir in weather.pm
2021-04-07 13:39:04 +03:00
eleksir
57dee8b168 Replace HTTP::Tiny with Mojo::UserAgent and Mojo::UserAgent::Cached 2021-04-05 12:10:31 +03:00
eleksir
5d17018490 Update Teapot::Bot to v5.1 api data types, add some debug 2021-04-04 22:44:28 +03:00
eleksir
b8fb89358e Try not to die if tg api call timeouts or api returns garbage 2021-03-30 20:04:21 +03:00
eleksir
c6ce5b1421 Perlcritic and similar fixes, no functional changes 2021-03-27 10:35:04 +03:00
eleksir
36208a35d5 botlib.pm: Add use monkeyuser to fix it 2021-03-22 13:48:47 +03:00
eleksir
23471ee185 Implement !drink and !праздник commands 2021-03-14 17:45:35 +03:00
eleksir
3a39cf8513 Update README.md 2021-03-12 15:07:50 +03:00
eleksir
bca6ee8512 sample_config.json: Update sample config 2021-03-12 11:22:42 +03:00
eleksir
2af166e3e6 Implement !monkeyuser command 2021-03-10 12:59:51 +03:00
eleksir
6735d6217a Implement !buni command 2021-03-09 15:52:48 +03:00
eleksir
3eb3e2126d Implement !xkcd command 2021-03-08 16:22:39 +03:00
eleksir
c58a571da5 flickr.pm: handle error, more safe work with db
* Untie %secret explicitly to prevent possible data corruption
* Handle case when verifier is in config but request token absent in db
2021-03-07 21:38:34 +03:00
eleksir
efea02972c Move away imgur client to imgur.pm, make typing notification before do web api queries, update gitignore 2021-03-07 21:17:24 +03:00
eleksir
d55d35f877 Implement !owl and !сова commands and improve !rabbit and co commands 2021-03-07 15:51:40 +03:00
eleksir
c8a766881e flickr.pm: Implement flickr.com searching api 2021-03-07 14:34:16 +03:00
eleksir
f669186787 image.pm: use large thumbnail instead of real photo in imgur plugin 2021-03-02 01:36:54 +03:00
eleksir
1991edc803 botlib.pm: forgot that rabbit() should be explicitly imported 2021-03-01 02:39:00 +03:00
eleksir
bdcd3b56e5 Update README.md - this bot not so simple already 2021-03-01 02:12:25 +03:00
eleksir
5d14f08084 Implement (beta-quality) !rabbit, !bunny, !кролик commands and imgur api client for them 2021-03-01 02:10:58 +03:00
eleksir
dd67f33ec5 Merge fox and kitty plugins to image.pm, add oboobs, obutts command family, extend/fix admin.pm
* Merge fox and kitty plugins to image.pm
* Add !tits, !tities, !boobs, !boobies, !сиси, !сисечки commands
* Add !butt, !booty, !ass, !попа, !попка commands
* Add generic interface for plugin toggle flags
* Fix a bit morning fortune status plugin
2021-02-25 22:54:04 +03:00
eleksir
f4651ff915 Add !fox and !лис commands 2021-02-24 00:24:33 +03:00
eleksir
9fc11c7cf4 Admin censor: voice messages are special 2021-02-23 20:07:16 +03:00
eleksir
04cb3d2357 First run with admin module: fix typos in ChatMember.pm, Brain.pm, admin.pm, botlib.pm 2021-02-23 18:16:24 +03:00
eleksir
e38726a1f2 Move admin commands to dedicated module, allow use admin stuff only to admins of chat 2021-02-23 14:02:56 +03:00
eleksir
79004942bd Teapot lib: document canTalk() function 2021-02-22 23:49:42 +03:00
eleksir
52724accee Teapot lib: Implement ability to delete message in chat 2021-02-22 23:45:37 +03:00
eleksir
4bdaea0a42 Do not answer back if someone quote our new member greet 2021-02-11 20:34:22 +03:00
eleksir
041ab3efeb Fix fortune src filename check and another pack of style and natural language fixes 2021-02-09 00:57:08 +03:00
eleksir
5d0fe793fd fisher.pm: there can be not just water 2021-02-08 13:46:13 +03:00
eleksir
4616470584 Fix 2 more typos - assign last name when it exist 2021-02-07 21:30:39 +03:00
eleksir
9732e71775 Define really empty array for newcomers
* Array for new member was defined with 1 empty value, but it must be empty array
* For more than 1 member added, last member should be enumerated via "и", not ","
2021-02-07 20:56:54 +03:00
eleksir
626feed7db Use markdown + quote for fortune, use irand() instead of int (rand()) 2021-02-07 18:37:30 +03:00
eleksir
f043fe5d78 Fix three typos since last commit 2021-02-07 14:08:29 +03:00
eleksir
054809ad3e telegrambot.pm: correctly handle new_chat_member event
* Extract newcommers from new_chat_members array, not from from-field
2021-02-07 13:53:30 +03:00
eleksir
35148838f9 Add commands !fish !fishing !рыба !рыбалка !рыбка, tweak archeologist.pm
* Rearrange .gitignore
+ Add fisher.pm with fishing commands
* Max probability in archeologist.pm should not exceed 100%
2021-02-07 13:51:55 +03:00
eleksir
a1d238949f Refactor code
* move plugins out of botlib.pm
* use make_path instead of mkpath
* squash some bugs
* update .gitignore
* use more correct randomizer, rather than perl own rand()
* coding style fixes
2021-02-06 19:06:59 +03:00
eleksir
8a521d3f3b Use bot name from api instead of config value
* Use API for bot username and full name
* Return if unable to getMe()
* Return if unable to get chat_id
* Drop handling non-text msgs, they never was implemented
2021-01-05 10:55:01 +03:00
eleksir
d32a25f93b Extend MOTD intro phrase list 2021-01-05 00:22:39 +03:00
eleksir
94f37408d7 InlineKeyboardButton: remove doubling field 2021-01-04 18:15:08 +03:00
eleksir
a108ebd701 archeologist.pm: tweak a bit probabilities 2020-12-26 17:54:45 +03:00
eleksir
f58046599c Expand list of archeological findings thanks to @ArtemisFaul 2020-12-26 17:46:40 +03:00
eleksir
380bff679e Add google_place_id and google_place_type fields to Venue object 2020-12-22 01:32:50 +03:00
eleksir
7d3d17f807 Add small_file_unique_id and big_file_unique_id fields to ChatPhoto object 2020-12-22 01:30:15 +03:00
eleksir
a9c049da13 Add horizontal_accuracy, live_period, heading, proximity_alert_radius, to Location object 2020-12-22 01:26:39 +03:00
eleksir
ade7cefe5a ChatMember.pm: Add is_anonymous field, rename until -> until_date 2020-12-22 01:22:11 +03:00
eleksir
6d7830024c Update Poll object fields 2020-12-22 01:13:06 +03:00
eleksir
33616284ca Add PollAnswer object 2020-12-22 01:12:38 +03:00
eleksir
d8728b383e Chat.pm: add linked_chat_id and location fields 2020-12-22 00:46:32 +03:00
eleksir
59e8fa525a Add ChatLocation object 2020-12-22 00:45:39 +03:00
eleksir
afe50154ab Base.pm: perlcritic fixes 2020-12-21 23:59:08 +03:00
eleksir
252bb86eb8 Add fields sender_chat, dice and proximity_alert_triggered to Message.pm
+ Add fields sender_chat, dice and proximity_alert_triggered
* Re-arrange fields list in online-docs' order
* perlcritic fixes
2020-12-21 23:55:15 +03:00
eleksir
2b06abdbf4 Add object Dice 2020-12-21 23:54:03 +03:00
eleksir
083ae88386 Add object ProximityAlertTriggered 2020-12-21 23:53:24 +03:00
eleksir
3787bb3073 Implement !cat and !кис commands 2020-12-20 15:30:19 +03:00
eleksir
0cfecd72b3 Implement fuzzy matching in bred answer checking to avoid repeating input phrase. 2020-12-20 14:43:32 +03:00
eleksir
07275c5b43 Re-run Mojo::Loop everytime it dies, not just once. 2020-12-19 22:01:08 +03:00
eleksir
8bbe3b5d18 Make use of replyMd() in newcommer greet, add botsleep() utility sub 2020-12-19 17:34:20 +03:00
eleksir
10fc353924 Move !help to botlib.pm 2020-12-19 17:25:20 +03:00
eleksir
4a312e23d1 Add replyMd() to message object, implement canTalk() check in Teapot lib, re-arrange code 2020-12-19 17:15:01 +03:00
eleksir
cc43141d20 Implement !dig and !копать commands, fix typo in help message 2020-12-19 01:22:51 +03:00
eleksir
642aadfd84 Print chat mention to log only on debug "loglevel" 2020-12-17 11:59:11 +03:00
eleksir
0327130a5d Telegram api can give us unexpected data during outage, try not to die/hang 2020-12-17 11:54:43 +03:00
eleksir
e861f5420b Implement logging via Log::Any, cleanup, remove logger() 2020-12-13 16:23:16 +03:00
eleksir
a9193faf12 Do not answer in chat if quoted mention less than 4 chars. 2020-12-02 20:26:16 +03:00
eleksir
0256f6b45b Trim() phrase before putting it to karma 2020-12-01 19:47:13 +03:00
eleksir
1031fe9242 Enhance friday.txt file parser, add some quotes to friday.txt 2020-11-22 17:46:23 +03:00
eleksir
63304d6bb9 First run fixes for fortune commands, also fixes for karma 2020-11-22 17:43:05 +03:00
eleksir
ad37a349c1 Implement fortune commands set
+ !f, !ф, !fortune, !фортунка - show random phrase from fortune_mod db
+ !f 1, !ф 1, !fortune 1, !фортунка 1 - show fortune in chat at ~8 am
+ !f 0, !ф 0, !fortune 0, !фортунка 0 - do not show fortune in the morning
+ !f ?, !ф ?, !fortune ?, !фортунка ? - query morning fortune status
2020-11-22 15:17:34 +03:00
eleksir
25b25ade5c lat.pm: use source file with phrases from config 2020-11-21 15:51:35 +03:00
eleksir
e448225a7b Implement !friday and !пятница commands 2020-11-21 15:47:53 +03:00
eleksir
48c07b0073 Use same config parsing method for confcheck.pl too 2020-11-21 15:30:28 +03:00
eleksir
ac8c0f17de Fix karma, fix private commands, actually add !помощь command
* Fix zero length !karma parsing
* In private chat commands not working except !help
* Miss to add !помощь to parser, so it was noop
2020-11-17 01:51:20 +03:00
eleksir
4bf814c473 Move chat commands to botlib.pm, implement !version, !ver, !версия command 2020-11-15 21:43:41 +03:00
eleksir
ba56ea72a2 Fix typo in README.md 2020-11-15 20:40:54 +03:00
eleksir
c6c53d6ebf First karma run fixes
Thanks Ilya Savin for very special utf8 test case for karma.
2020-11-12 20:53:24 +03:00
eleksir
c71ba14bdc Make use of karma module 2020-11-12 00:45:16 +03:00
eleksir
8cb69e554d Add karma module 2020-11-12 00:42:21 +03:00
eleksir
97434d511b Make most of processing errors non-critical. 2020-11-11 23:12:55 +03:00
eleksir
05f8990f5e Fix sending local photos by ctaulien 2020-11-11 21:35:10 +03:00
eleksir
621d19486d Update README.md because of bundling Telegram::Bot with bot as Teapot::Bot 2020-11-07 18:08:04 +03:00
eleksir
57120eb461 Bump ver in Teapot::Bot 0.021 -> 0.022 and clenup modules
- Remove Encode module from cpanfile and telegrambot.pm
+ Add Mojo::IOLoop, Mojo::UserAgent, IO::Socket::SSL
* Sort cpanfile
* Bump version Teapot::Bot 0.021 -> 0.022
* Add aleesa-telegram-bot.pid to .gitignore
2020-11-07 17:54:58 +03:00
eleksir
97eddd414d Lint Teapot::Bot with perlcritic
* Use List::Util' any instead of grep in Base.pm
* Use croak() in Base.pm
2020-10-31 13:49:37 +03:00
eleksir
a480786afa First run of Teapot::Bot fixes.
* Fix typos in Brain.pm
* Fix typos in User.pm
* Implement typing methods in Message object and make use of it
* Fix incorrect syntax of unless loops in telegrambot.pm
* Add Log::Any as it required by Teapot::Bot
* Do not use --update in bootstrap.sh
* Add data/lat to .gitignore
* Load ChatMember and ChatPermissions in Message object, so we can use 'em and avoid crash
* Supply missing $send_args to _post_request
2020-10-30 18:14:00 +03:00
eleksir
43c0286414 Use Teapot' sendChatAction, getChat and getChatMember, remove dups of these subs in telegramlib.pm 2020-10-30 16:15:11 +03:00
eleksir
f0b1ae9c43 Set default action to "typing" if not supplied in sendChatAction() 2020-10-30 16:14:28 +03:00
eleksir
29c1fa8d07 Breaking API changes (handle Mojo loop errors), fix sendMessage method broken in 033441c
* Use general method to handle Mojo loop unsuccessful operations
* Do not die if tg api returns error via Mojo loop, lift up error status to upper layer
* Die with confess only in case of Mojo loop does not returns either is_success or is_error set
* Handle incomming updates related to poll event
* Update inline POD in Brain.pm
* Fix overlooked die removal in sendMessage, now it is croak
2020-10-30 15:42:36 +03:00
eleksir
c1b6ca013d More safe actions in Brain.pm 2020-10-30 15:16:45 +03:00
eleksir
edcd382183 Change fields in Chat object
- Removed all_members_are_administrators
+ Add permissions;
+ Add slow_mode_delay;
2020-10-30 13:58:37 +03:00
eleksir
75ee83c94f Implement ChatPermissions object 2020-10-30 13:39:03 +03:00
eleksir
f93f974cb4 Fix Version in ChatMember.pm 2020-10-30 13:37:40 +03:00
eleksir
a1da4b193d Add field via_bot to Message object 2020-10-30 13:36:38 +03:00
eleksir
0576a1ea57 Implement getChat() with inline POD 2020-10-30 13:10:33 +03:00
eleksir
1a8fa3e089 Add new fields to User and MessageEntity objects 2020-10-29 16:28:43 +03:00
eleksir
74e58db1b8 Implement getChatMember() with inline POD 2020-10-29 16:06:19 +03:00
eleksir
5cba9755af Implement ChatMember object 2020-10-29 15:56:00 +03:00
eleksir
113a918010 Some more work on sendChatAction()
* Fix return value
* Add POD inline for this method
2020-10-29 15:53:31 +03:00
eleksir
45318757df Implement sendChatAction() 2020-10-28 18:19:29 +03:00
eleksir
033441c513 First touch to satisfy perlcritic 2020-10-28 18:18:09 +03:00
eleksir
f816840e14 Now Telegram::Bot is Teapot::Bot 2020-10-28 18:12:49 +03:00
eleksir
c3818e5dee Vendor Telegram::Bot 2020-10-28 18:06:21 +03:00
eleksir
c9b46cc6f0 Use sendChatAction() correctly 2020-10-28 16:25:54 +03:00
eleksir
0397b3c9cf Rename .perlcriticrc file 2020-10-28 15:20:38 +03:00
eleksir
295835c283 Add famous latin prases module 2020-10-22 13:49:45 +03:00
eleksir
9c629a8dbc Use perlcritic to lint the code, make it happy 2020-10-19 18:01:47 +03:00
eleksir
9abb221dac Make bot more human-like by delaying answers
- Greet newcommers with notable randomized delay + send "typing", pretending we are real human :)
- Make 1-2 second delay in group chat before answer.
2020-10-10 14:17:25 +03:00
eleksir
0d0b8bb4c2 Add one more common phrase 2020-10-03 19:12:05 +03:00
eleksir
04706f20e2 Use user id in mention of newcommers when greet them 2020-09-27 14:49:32 +03:00
eleksir
1567fbe0db New logging, handle bot quote in groups, newcommer greets reworked
+ More sane and verbose logging
* Newcommer greet now should now mention newcommer
+ If someone in group quote bot's phrase, bot should answer
* Move some subs related to framework to telegramlib.pm
* Handle (log only for now) sent media - documents, stickers, photos in public chats (voice, audio, video still unhandled)
2020-09-26 21:36:37 +03:00
eleksir
376cbdfbe5 Add debug messages to some events 2020-09-21 02:13:20 +03:00
eleksir
f0d8e90441 Add date to logger() messages like in bsd syslog 2020-09-21 02:11:47 +03:00
eleksir
1822054f03 Fix fool typo that prevents daemon from start 2020-09-21 02:09:21 +03:00
eleksir
ab27431e83 Edit spelling and enhance README.md 2020-09-19 14:57:05 +03:00
eleksir
d53ee53ad8 Use Cwd::utf8 to cope with returning string ut8-ness
* Use Cwd::utf8
* Sort cpanfile require, remove duplicates, add Cwd::utf8
* Add check on first call of abs_path()
2020-09-19 14:48:29 +03:00
eleksir
9461042ec4 Use botlib own trim() 2020-09-19 14:43:48 +03:00
eleksir
04057e10e1 Paint help message in markdown 2020-09-12 14:02:41 +03:00
62 changed files with 5782 additions and 719 deletions

19
.gitignore vendored
View File

@@ -1,5 +1,16 @@
vendor_perl _Deparsed_XSubs.pm
.idea/**
.vscode/**
.vstags
aleesa-telegram-bot.pid
data/cache/**
data/config.json data/config.json
data/cache data/fortune/**
data/telegrambot-brains data/friday/**
TODO data/gamestat/**
data/image/**
data/karma/**
data/lat/**
data/proverb/**
data/telegrambot-brains/**
vendor_perl/**

98
.perlcriticrc Normal file
View File

@@ -0,0 +1,98 @@
#!/usr/bin/env perlcritic
severity = 5
verbose = 8
# minorify some of warnings that are not really critical
[-InputOutput::RequireCheckedClose]
# What can we handle in case of error?
[-Modules::ProhibitExcessMainComplexity]
# Noone cares
[-Subroutines::ProhibitExcessComplexity]
# Noone cares
[-Subroutines::ProhibitExplicitReturnUndef]
# But it's very handy sometimes!
[-ValuesAndExpressions::ProhibitMagicNumbers]
# this policy makes too much false positives
[-RegularExpressions::RequireLineBoundaryMatching]
# We use /m as needed
[-RegularExpressions::RequireExtendedFormatting]
# We do not use extended formatting of regex, they still not THAT complex
[-RegularExpressions::RequireDotMatchAnything]
# huh?
[-RegularExpressions::ProhibitEscapedMetacharacters]
# Looks like it pointless
[-ControlStructures::ProhibitCascadingIfElse]
# I like long if..else chains
[-ControlStructures::ProhibitPostfixControls]
# In short lines we can afford ourselves to use postfix controls
# but ofcorse we should avoid such constructions in long lines.
[-Subroutines::ProhibitSubroutinePrototypes]
# Contrary to Perl::Critic we consider prototypes as useful, even if
# the compile-time checks of Perl are not perfect, Perl may give some
# hints.
[-CodeLayout::RequireTidyCode]
# Impossible to complete, because of on higher linting levels "## no critic..."
# require be per-case on same line where critique is, but tidy align them
# one line down.
[-CodeLayout::ProhibitParensWithBuiltins]
# duh...
[-ValuesAndExpressions::ProhibitEmptyQuotes]
# cause we consider following correct and useful: my $var = '';
# the recommended use of q{} looks too complex: my $var = q{};
[-ValuesAndExpressions::ProhibitNoisyQuotes]
# Other people, other opinions: "," is better readable than qw(,)
[-BuiltinFunctions::ProhibitSleepViaSelect]
# We do not wish to use too much external modules.
# select undef, undef, undef, 0.25; # actually is okay if you add comment that
# it is sleep for 0.25 seconds
[-NamingConventions::Capitalization]
# duh...
# Noone care, really
[-ControlStructures::ProhibitUnlessBlocks]
# They should not be too complex - only one condition should be checked,
# that's all
[-Miscellanea::ProhibitTies]
# Just allow it. It's very handy stuff and extremely simple and safe enugh to use.
[-ValuesAndExpressions::RequireNumberSeparators]
# Not really
[-InputOutput::RequireBracedFileHandleWithPrint]
# We prefer not to use braced file handles
[-Documentation::PodSpelling]
# It doesn't help, but emits annoying errors
[Documentation::RequirePodSections]
# Considering this as "soft" requirement. For modules that is (or will be)
# stand-alone libs well formed documentation is highly desired.
lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
[-InputOutput::RequireBriefOpen]
# Yes, i do!
[-ControlStructures::ProhibitDeepNests]
# Have to use it, so fuckoff
[-ControlStructures::ProhibitUntilBlocks]
# Until is really useful if condition is simple, so let's assume condition is
# always simple to read

View File

@@ -1,51 +1,48 @@
# Aleesa-Telegram-bot - Simple Telegram chatty bot # Aleesa-Telegram-bot - Telegram chatty bot
## About ## About
It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation It is based on Perl modules [Telegram::Bot][1] and [Hailo][2] as conversation
generator. generator.
Config located in **data/config.json**, sample config provided as 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**. **data/sample_config.json**.
Bot can be run via **bin/aleesa-telegam-bot** and acts as daemon. Bot can be run via **bin/aleesa-telegram-bot** and acts as daemon (double
fork() and detaches stdio).
## Installation ## Installation
In order to run this application, you need to "bootstrap" it - download all In order to run this application, you need to "bootstrap" it - download and
dependencies and libraries. build all required dependencies and libraries.
You'll need "Development Tools" or similar group of packages, perl, perl-devel, You'll need perl-5.18 or newer, "Development Tools" or similar group of
perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel, packages, perl, perl-devel, perl-local-lib, perl-app-cpanm, sqlite-devel,
libdb4-devel (Berkeley DB devel), make. zlib-devel, openssl-devel, libdb4-devel (Berkeley DB devel), make,
hiredis-devel.
After installng required dependencies it is possible to run: After installing required dependencies it is possible to run:
```bash ```bash
bash bootstrap.sh bash bootstrap.sh
``` ```
and all libraries should be downloaded and built. and all libraries should be downloaded, built, tested and installed.
## N.B. ## Running
If bot is unable to post to channel due to limitated permissions, it will die. This bot does not [ultilize][4] webhooks, so in order to run it only well
It if possible to change this behavior by patching Telegram/Bot/Brain.pm: internet connection is required, no public-available ip address is needed.
```diff
--- Brain.pm 2019-07-01 04:04:17.000000000 +0300
+++ Brain.pm.new 2020-09-05 22:25:20.941373455 +0300
@@ -237,8 +237,9 @@
my $res = $self->ua->post($url, form => $form_args)->result;
if ($res->is_success) { return $res->json->{result}; }
- elsif ($res->is_error) { die "Failed to post: " . $res->message; }
- else { die "Not sure what went wrong"; }
+ elsif ($res->is_error) { warn "Failed to post: " . $res->message; }
+ else { warn "Not sure what went wrong"; }
+ return "";
}
```
[1]: https://metacpan.org/pod/Telegram::Bot [1]: https://metacpan.org/pod/Telegram::Bot
[2]: https://metacpan.org/pod/Hailo [2]: https://metacpan.org/pod/Hailo
[3]: https://core.telegram.org/bots/api
[4]: https://core.telegram.org/bots/api#getting-updates

48
README_RU.md Normal file
View File

@@ -0,0 +1,48 @@
# 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, hiredis-devel.
После установки этих пакетов, можно будет запустить:
```bash
bash bootstrap.sh
```
и, по идее, всё что нужно будет выкачено, собрано и разложено куда надо.
## Запуск и работа
Бот не использует [вебхуки][4], поэтому ничего дополнительного, кроме хорошего
подключения к интернету ему не нужно.
[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

View File

@@ -2,43 +2,67 @@
use 5.018; use 5.018;
use strict; use strict;
use warnings "all"; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw (:std :utf8);
use English qw ( -no_match_vars );
use version; our $VERSION = qw (1.0);
my $workdir; my $workdir;
# before we run, change working dir # before we run, change working dir
BEGIN { BEGIN {
use Cwd qw(chdir abs_path); use Cwd qw (chdir abs_path);
my @CWD = split (/\//, abs_path ($0)); my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
if ($#CWD > 1) { $#CWD = $#CWD - 2; }
$workdir = join ('/', @CWD); if ($#CWD > 1) {
chdir ($workdir); $#CWD = $#CWD - 2;
}
$workdir = join '/', @CWD;
chdir $workdir;
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use POSIX qw(setgid setuid setsid); no Cwd;
use File::Path qw(make_path); use Cwd::utf8 qw (chdir abs_path);
use File::Basename qw(basename dirname); use File::Basename qw (basename dirname);
use conf qw(loadConf); use File::Path qw (make_path);
use botlib qw(logger); use Log::Any qw ($log);
use telegrambot qw(run_telegrambot); use Log::Any::Adapter;
use Log::Any::For::Std;
use POSIX qw (setgid setuid setsid);
use BotLib::Conf qw (LoadConf);
use TelegramBot qw (RunTelegramBot);
sub daemonize (); sub daemonize;
sub __fork (); sub __fork;
sub __signal_handler;
$| = 1; local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $<; my $runAsUid = $UID;
my $piddir = "/var/run/" . basename (abs_path ($0)); my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
my $C = loadConf (); my $C = LoadConf ();
my $loglevel = $C->{'loglevel'} // 'notice';
my $logfile;
if (defined $C->{'log'}) {
$logfile = $C->{'log'};
} elsif (defined $C->{'debug_log'}) {
$logfile = $C->{'debug_log'};
}
# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined # if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
if ($< == 0) { if ($UID == 0) {
my $user = $C->{user}; my $user = $C->{user};
die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined ($user));
my ($uid, $gid) = (getpwnam ($user))[2,3]; unless (defined $user) {
die "Unable to run as root, please define unprivileged user in config.json\n";
}
my ($uid, $gid) = (getpwnam $user)[2,3];
unless (-d $piddir) { unless (-d $piddir) {
make_path ( make_path (
@@ -49,56 +73,126 @@ if ($< == 0) {
); );
} }
if ($C->{'debug_log'}) { if (defined $logfile) {
unless (-d dirname($C->{'debug_log'})) { my $logdir = dirname $logfile;
unless (-d $logdir) {
make_path ( make_path (
dirname($C->{'debug_log'}), { $logdir, {
uid => $uid, uid => $uid,
group => $gid group => $gid
} }
); ) or die "Unable to create $logdir: $OS_ERROR\n";
} }
} }
# drop privs # drop privs
setgid ($gid) or die "Unable to switch to group of $user($!)\n"; setgid ($gid) or die "Unable to switch to group of $user($OS_ERROR)\n";
setuid ($uid) or die "Unable to switch to account $user($!)\n"; setuid ($uid) or die "Unable to switch to account $user($OS_ERROR)\n";
} else { } else {
$piddir = $workdir; $piddir = $workdir;
} }
if (defined $logfile) {
Log::Any::Adapter->set ('File', $logfile, log_level => $loglevel);
# Some annoying CHI logging events come with category set to CHI::Driver and log_level set to debug.
# Until we use start using Log::Any native features and set whole loglevel accordingly, lets lower
# verbosity paticulary for CHI.
Log::Any::Adapter->set (
{
category => 'CHI::Driver'
},
'File',
$logfile,
log_level => 'warn'
);
} else {
Log::Any::Adapter->set ('File', '/dev/null');
}
# double fork attach to /dev/null all stdio and go background # double fork attach to /dev/null all stdio and go background
daemonize (); daemonize ();
# write pidfile # write pidfile
my $pidfile = sprintf ("%s/%s.pid", $piddir, basename (abs_path ($0))); my $apath = abs_path $PROGRAM_NAME;
logger ("Creating pidfile at $pidfile");
open (PID, ">", $pidfile) or die "Error opening $pidfile: $!\n"; unless (defined $apath) {
print PID $$ or die "Error writing to $pidfile: $!\n"; $log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
close PID; exit 1;
};
# write pidfile
my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
$log->info ("[INFO] Creating pidfile at $pidfile");
open my $MYPID, '>', $pidfile or do {
$log->fatal ("[FATAL] Error opening $pidfile: $OS_ERROR");
exit 1;
};
print {$MYPID} $PID or do {
$log->fatal ("[FATAL] Error writing to $pidfile: $OS_ERROR");
exit 1;
};
close $MYPID; ## no critic (InputOutput::RequireCheckedSyscalls
local $SIG{INT} = \&__signal_handler;
local $SIG{TERM} = \&__signal_handler;
# set correct proctitle # set correct proctitle
$0 = abs_path ($0); $PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars)
# make some global vars for telegram and redis context
our $TGM;
our $REDIS;
our $RCONN;
# run bot, at last # run bot, at last
run_telegrambot (); RunTelegramBot ();
unlink ($pidfile) if (-f $pidfile);
exit 0;
sub daemonize () { if (-f $pidfile) {
__fork (); unlink $pidfile;
POSIX::setsid ();
open (STDIN, "<", "/dev/null");
open (STDOUT, ">", "/dev/null");
open (STDERR, ">", "/dev/null");
__fork ();
umask 0;
} }
sub __fork () { exit 0;
sub daemonize {
__fork ();
POSIX::setsid ();
open STDIN, '<', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
# we handle STDOUT && STDERR via Log::Any::For::Std, so do not close them explicitly
#open STDOUT, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
#open STDERR, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
__fork ();
umask 0;
return;
}
sub __fork {
my $pid = fork; my $pid = fork;
die "Can't fork: $!\n" unless (defined ($pid));
exit if ($pid != 0); unless (defined $pid) {
$log->fatal ("[FATAL] Can't fork: $OS_ERROR");
exit 1;
}
if ($pid != 0) {
exit;
}
return;
}
sub __signal_handler {
$log->info ("[INFO] Caught a signal $OS_ERROR");
if (-f $pidfile) {
unlink $pidfile;
}
exit 0;
} }
__END__ __END__

View File

@@ -1,5 +1,5 @@
#!/bin/bash #!/bin/bash
cpanm -l vendor_perl --self-contained --force --update --installdeps . cpanm -l vendor_perl --self-contained --force --installdeps .
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: # vim: set ft=sh noet ai ts=4 sw=4 sts=4:

View File

@@ -2,34 +2,36 @@
use 5.018; use 5.018;
use strict; use strict;
use warnings "all"; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw (:std :utf8);
use English qw ( -no_match_vars );
use lib qw (./lib ./vendor_perl ./vendor_perl/lib/perl5);
use JSON::XS;
use lib ("./lib", "./vendor_perl", "./vendor_perl/lib/perl5"); use version; our $VERSION = qw (1.0);
use JSON::PP; my $c = 'data/config.json';
open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n";
my $c = "data/config.json"; my $len = (stat $c) [7];
open (C, "<", $c) or die "No conf at $c: $!\n";
my $len = (stat ($c)) [7];
my $json; my $json;
my $readlen = read (C, $json, $len); my $readlen = read ($C, $json, $len);
unless ($readlen) { unless ($readlen) {
close C; close C; ## no critic (InputOutput::RequireCheckedSyscalls)
die "Unable to read $c: $!\n"; die "Unable to read $c: $OS_ERROR\n";
} }
if ($readlen != $len) { if ($readlen != $len) {
close C; close C; ## no critic (InputOutput::RequireCheckedSyscalls)
die "File $c is $len bytes on disk, but we read only $readlen bytes\n"; die "File $c is $len bytes on disk, but we read only $readlen bytes\n";
} }
close C; close C; ## no critic (InputOutput::RequireCheckedSyscalls)
$c = decode_json ($json); $c = JSON::XS->new->utf8->relaxed;
my $data = $c->decode ($json);
my $j = JSON::PP->new->pretty->canonical->indent_length (4); my $j = JSON::XS->new->pretty();
print $j->encode ($c); print $j->encode ($data); ## no critic (InputOutput::RequireCheckedSyscalls)
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

View File

@@ -1,14 +1,37 @@
requires 'local::lib'; requires 'Carp';
requires 'JSON'; requires 'Clone';
requires 'Hailo'; requires 'CHI';
requires 'Telegram::Bot'; requires 'CHI::Driver::BerkeleyDB';
requires 'Cwd::utf8';
requires 'DateTime';
requires 'DB_File'; requires 'DB_File';
requires 'SQLite_File';
requires 'DBI';
requires 'DBD::SQLite';
requires 'Digest::HMAC_SHA1';
requires 'Digest::MD5'; requires 'Digest::MD5';
requires 'Encode'; requires 'Data::Dumper';
requires 'File::Path'; requires 'Digest::SHA';
requires 'File::Basename'; requires 'File::Basename';
requires 'HTTP::Tiny'; requires 'File::Path';
requires 'Hailo'; requires 'Hailo';
requires 'HTML::TokeParser';
requires 'IO::Socket::SSL';
requires 'JSON';
requires 'JSON::XS'; requires 'JSON::XS';
requires 'List::Util';
requires 'local::lib';
requires 'Log::Any';
requires 'Log::Any::Adapter';
requires 'Log::Any::For::Std';
requires 'Math::Random::Secure';
requires 'Mojo::Base'; requires 'Mojo::Base';
requires 'Mojo::IOLoop';
requires 'Mojo::Redis';
requires 'Mojo::UserAgent';
requires 'Mojo::UserAgent::Cached';
requires 'Protocol::Redis::XS';
requires 'String::Random';
requires 'Text::Fuzzy';
requires 'URI::Encode::XS';
requires 'URI::URL'; requires 'URI::URL';

View File

@@ -1,16 +1,39 @@
{ {
"user" : "nobody", # Cachedir used not only for caches but for some settings and stats too.
"cachedir" : "data/cache",
"gamestat" : {
"dir" : "data",
"gamestatdir" : "data/gamestat"
},
# Required for debugging reasons, if commented out or not exist, no debug logging appears at all.
"log" : "/var/log/aleesa-telegram-bot/aleesa.log",
# Verbosity can be trace, debug, info (inform), notice, warning (warn), error (err), critical (crit, fatal), alert, emergency.
# Currently implemented debug, info, notice, warn, error, fatal. Notice is default logging level.
"loglevel": "notice",
# Stuff for telegram itself.
"telegrambot" : { "telegrambot" : {
"name" : "mybot",
"tname" : "@my_bot", # 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. In case of this bot you can define what to use.
"csign" : "!", "csign" : "!",
"token" : "get_it_from_botfather",
"braindir": "data/telegrambot-brains" "token" : "Long_string_given_by_@BotFather"
}, },
"openweathermap" : {
"cachetime": "data/cache/openweathermap.Id-Timestamp.db", # Unprivileged user to run this bot from.
"cachedata": "data/cache/openweathermap.Id-Data.db", "user" : "nobody",
"appid": "get_it_on_openweathermap.org"
}, "redis_server": "127.0.0.1",
"debug_log" : "/var/log/aleesa-telegram-bot/debug.log" "redis_port" : "6379",
"redis_channels" : [
"telegram"
],
"redis_router_channel" : "misc"
} }

387
lib/BotLib.pm Normal file
View File

@@ -0,0 +1,387 @@
package BotLib;
# store here utility functions that are not protocol-specified
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (carp);
use Clone qw (clone);
use Math::Random::Secure qw (irand);
use Data::Dumper;
use Log::Any qw ($log);
use BotLib::Conf qw (LoadConf);
use BotLib::Admin qw (@ForbiddenMessageTypes GetForbiddenTypes AddForbiddenType
DelForbiddenType ListForbidden FortuneToggle FortuneStatus
PluginToggle PluginStatus PluginEnabled ChanMsgToggle ChanMsgStatus);
use BotLib::Util qw (trim);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Command Highlight BotSleep IsCensored);
my $c = LoadConf ();
my $csign = $c->{telegrambot}->{csign};
my $redismsg->{from} = 'telegram';
$redismsg->{plugin} = 'telegram';
$redismsg->{misc}->{answer} = 1;
$redismsg->{misc}->{csign} = $c->{telegrambot}->{csign};
$redismsg->{misc}->{msg_format} = 0;
$redismsg->{misc}->{fwd_cnt} = 1;
sub Command {
my $self = shift;
my $msg = shift;
my $text = shift;
my $chatid = shift;
my $reply;
my ($userid, $username, $fullname, $highlight, $visavi) = Highlight ($msg);
my $rmsg = clone ($redismsg);
$rmsg->{userid} = $userid;
$rmsg->{chatid} = $chatid;
if ($chatid >= 0) {
$rmsg->{mode} = 'private';
} else {
$rmsg->{mode} = 'public';
}
my $cmd = substr $text, 1;
# Проверка #1 на админское разрешение некоторых команд
my @cmds = qw (tits boobs tities boobies сиси сисечки);
while (my $check = pop @cmds) {
if ($cmd eq $check) {
unless (PluginEnabled $chatid, 'oboobs') {
return;
}
}
}
# Проверка #2 на админское разрешение некоторых команд
$#cmds = -1;
@cmds = qw (butt booty ass попа попка);
while (my $check = pop @cmds) {
if ($cmd eq $check) {
unless (PluginEnabled $chatid, 'obutts') {
return;
}
}
}
# Полноценный поиск простой команды во входящем сообщении
$#cmds = -1;
@cmds = qw (ping пинг пинх pong понг понх coin монетка roll dice кости ver version версия хэлп halp kde кде lat
лат friday пятница proverb пословица fortune фортунка f ф anek анек анекдот buni cat кис drink праздник fox лис
frog лягушка horse лошадь лошадка monkeyuser owl сова сыч rabbit bunny кролик snail улитка tits boobs tities
boobies сиси сисечки butt booty ass попа попка xkcd dig копать fish fishing рыба рыбка рыбалка);
my $bingo = 0;
while (my $check = pop @cmds) {
if ($cmd eq $check) {
$bingo = 1;
last;
}
}
# Поиск "сложных" команд во входящем сообщении
if (($cmd =~ /^w\s/u) || ($cmd =~ /^п\s/u) || ($cmd =~ /^weather\s/u) || ($cmd =~ /^погода\s/u) ||
($cmd =~ /^погодка\s/u) || ($cmd =~ /^погадка\s/u) || ($cmd =~ /^karma\s/u) || ($cmd =~ /карма\s/u)) {
$bingo = 1;
}
# Если команда найдена...
if ($bingo) {
$rmsg->{message} = $text;
$self->log->debug ('[DEBUG] Sending message to redis ' . Dumper ($rmsg));
# Для некоторых команд мы хотим получать форматированный вывод
$#cmds = -1;
@cmds = qw (fortune фортунка f ф anek анек анекдот buni cat кис fox лис frog лягушка horse лошадь
лошадка monkeyuser owl сова сыч rabbit bunny кролик snail улитка tits boobs tities boobies сиси сисечки
butt booty ass попа попка xkcd);
while (my $check = pop @cmds) {
if ($cmd eq $check) {
$rmsg->{misc}->{msg_format} = 1;
last;
}
}
# Для других команд, хотим, чтобы было упоминание пользователя в ответе, чтобы подсветить его
$#cmds = -1;
@cmds = qw (dig копать fish fishing рыба рыбка рыбалка);
while (my $check = pop @cmds) {
if ($cmd eq $check) {
$rmsg->{misc}->{msg_format} = 1;
$rmsg->{misc}->{username} = $highlight;
last;
}
}
# Если соединения с редиской нету, ждём, пока оно появится. Своего рода костыль на всякий случай.
{
do {
my $ready = eval { $main::RCONN->is_connected; };
last if ($ready);
} while (sleep 1);
}
my $pubsub = $main::REDIS->pubsub;
$pubsub->json ($c->{'redis_router_channel'})->notify (
$c->{'redis_router_channel'} => $rmsg
);
# Если команда не найдена, но строка подозрительно напоминает команду help
} elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') {
$reply = << "MYHELP";
```
${csign}help | ${csign}помощь - список команд
${csign}anek | ${csign}анек | ${csign}анекдот - рандомный анекдот с anekdot.ru
${csign}buni - рандомный стрип hapi buni
${csign}bunny | ${csign}rabbit | ${csign}кролик - кролик
${csign}cat | ${csign}кис - кошечка
${csign}coin | ${csign}монетка - подбросить монетку - орёл или решка?
${csign}dig | ${csign}копать - заняться археологией
${csign}drink | ${csign}праздник - какой сегодня праздник?
${csign}fish | ${csign}рыба | ${csign}рыбка - порыбачить
${csign}fishing | ${csign}рыбалка - порыбачить
${csign}f | ${csign}ф - рандомная фраза из сборника цитат fortune_mod
${csign}fortune | ${csign}фортунка - рандомная фраза из сборника цитат fortune_mod
${csign}fox | ${csign}лис - лисичка
${csign}friday | ${csign}пятница - а не пятница ли сегодня?
${csign}frog | ${csign}лягушка - лягушка
${csign}horse | ${csign}лошадка - лошадка
${csign}lat | ${csign}лат - сгенерить фразу из крылатых латинских выражений
${csign}monkeyuser - рандомный стрип MonkeyUser
${csign}owl | ${csign}сова | ${csign}сыч - сова
${csign}proverb | ${csign}пословица - рандомная русская пословица
${csign}ping | ${csign}пинг - попинговать бота
${csign}roll | ${csign}dice | ${csign}кости - бросить кости
${csign}snail | ${csign}улитка - улитка
${csign}ver | ${csign}version | ${csign}версия - что-то про версию ПО
${csign}w город | ${csign}п город - погода в указанном городе
${csign}weather город - погода в указанном городе
${csign}погода город - погода в указанном городе
${csign}погодка город - погода в указанном городе
${csign}погадка город - погода в указанном городе
${csign}xkcd - рандомный стрип с сайта xkcd.ru
${csign}karma фраза | ${csign}карма фраза - посмотреть карму фразы
фраза-- | фраза++ - убавить или добавить карму фразе
```
Но на самом деле я бот больше для общения, чем для исполнения команд.
Поговоришь со мной?
MYHELP
$msg->replyMd ($reply);
return;
# Если строка не найдена, но это команда admin
} elsif (substr ($text, 1) eq 'admin' || substr ($text, 1) eq 'админ') {
my $member = $self->getChatMember ({ 'chat_id' => $msg->chat->id, 'user_id' => $msg->from->id });
# Это должно показываться только админам чата
if (($member->status eq 'administrator') || ($member->status eq 'creator')) {
$reply = << "MYADMIN";
```
${csign}admin censor type # - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений
${csign}админ ценз тип # - где 1 - вкл, 0 - выкл цензуры для означенного типа сообщений
${csign}admin censor - показать список состояния типов сообщений
${csign}админ ценз - показать список состояния типов сообщений
${csign}admin fortune # - где 1 - вкл, 0 - выкл фортунку с утра
${csign}admin фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
${csign}admin fortune - показываем ли с утра фортунку для чата
${csign}admin фортунка - показываем ли с утра фортунку для чата
${csign}admin oboobs # - где 1 - вкл, 0 - выкл плагина oboobs
${csign}admin oboobs - показываем ли сисечки по просьбе участников чата (команды ${csign}tits, ${csign}tities, ${csign}boobs, ${csign}boobies, ${csign}сиси, ${csign}сисечки)
${csign}admin obutts # - где 1 - вкл, 0 - выкл плагина obutts
${csign}admin obutts - показываем ли попки по просьбе участников чата (команды ${csign}ass, ${csign}butt, ${csign}booty, ${csign}попа, ${csign}попка)
${csign}admin chan_msg - оставляем ли сообщения присланные от имени (других) каналов
${csign}admin chan_msg # - где 1 - оставляем, 0 - удаляем
```
Типы сообщений:
audio voice photo video animation sticker dice game poll document
MYADMIN
$msg->replyMd ($reply);
}
return;
# Если строка не найдена, но это команда admin с параметрами
} elsif ((substr ($text, 1, 5) eq 'admin' || substr ($text, 1, 5) eq 'админ') && (length ($text) >= 8)) {
my $member = $self->getChatMember ({ 'chat_id' => $msg->chat->id, 'user_id' => $msg->from->id });
# Это должно показываться только админам чата
if (($member->status eq 'administrator') || ($member->status eq 'creator')) {
# Вынем субкоманду, это первый аргумент команды admin
my $command = trim (substr $text, 7);
$cmd = undef;
my $args;
($cmd, $args) = split /\s+/, $command, 2;
# Субкоманды не нашлось, ну и какбэ досвидонья
if ($cmd eq '') {
return;
# Субкоманда censor...
} elsif ($cmd eq 'censor' || $cmd eq 'ценз') {
# Censor с аргументами
if (defined ($args) && ($args ne '')) {
my ($msgType, $toggle) = split /\s/, $args, 2;
if (defined $toggle) {
foreach (@ForbiddenMessageTypes) {
if ($msgType eq $_) {
if ($toggle == 1) {
AddForbiddenType ($chatid, $msgType);
$reply = "Теперь сообщения с $msgType будут автоматически удаляться";
} elsif ($toggle == 0) {
DelForbiddenType ($chatid, $msgType);
$reply = "Теперь сообщения с $msgType будут оставаться";
}
}
}
}
# Censor без аргументов, выдаёт список типов сообщений и будут ли они автоматически удаляться
} else {
$reply = ListForbidden ($chatid);
}
# Хотим ли мы показывать фортунку с утра
} elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') {
if (defined $args) {
if ($args == 1) {
$reply = FortuneToggle ($chatid, 1);
} elsif ($args == 0) {
$reply = FortuneToggle ($chatid, 0);
}
} else {
$reply = FortuneStatus ($chatid);
}
# Хотим ли мы удалять "сообщения от каналов"
} elsif ($cmd eq 'chan_msg') {
if (defined $args) {
if ($args == 1) {
$reply = ChanMsgToggle ($chatid, 1);
} elsif ($args == 0) {
$reply = ChanMsgToggle ($chatid, 0);
}
} else {
$reply = ChanMsgStatus ($chatid);
}
# Работает ли плагин oboobs в чатике
} elsif ($cmd eq 'oboobs') {
if (defined $args) {
if ($args == 1) {
$reply = PluginToggle ($chatid, 'oboobs', 1);
} elsif ($args == 0) {
$reply = PluginToggle ($chatid, 'oboobs', 0);
}
} else {
$reply = PluginStatus ($chatid, 'oboobs');
}
# Работает ли плагин obutts в чатике
} elsif ($cmd eq 'obutts') {
if (defined $args) {
if ($args == 1) {
$reply = PluginToggle ($chatid, 'obutts', 1);
} elsif ($args == 0) {
$reply = PluginToggle ($chatid, 'obutts', 0);
}
} else {
$reply = PluginStatus ($chatid, 'obutts');
}
}
}
}
return $reply;
}
sub Highlight {
my $msg = shift;
my $fullname;
my $highlight;
my $username;
my $visavi = '';
my $userid = $msg->from->id;
if ($msg->from->can ('username') && defined $msg->from->username ) {
$username = $msg->from->username;
}
if ($msg->from->can ('first_name') && defined $msg->from->first_name) {
$fullname = $msg->from->first_name;
if ($msg->from->can ('last_name') && defined $msg->from->last_name) {
$fullname .= ' ' . $msg->from->last_name;
}
} elsif ($msg->from->can ('last_name') && defined $msg->from->last_name) {
$fullname .= $msg->from->last_name;
}
if (defined $username) {
$visavi .= '@' . $username;
if (defined $fullname) {
$highlight = "[$fullname](tg://user?id=$userid)";
$visavi .= ', ' . $fullname;
} else {
$highlight = "[$username](tg://user?id=$userid)";
}
} else {
$highlight = "[$fullname](tg://user?id=$userid)";
$visavi .= $fullname;
}
$visavi .= " ($userid)";
return ($userid, $username, $fullname, $highlight, $visavi);
}
sub BotSleep {
# TODO: Parametrise this with fuzzy sleep time in seconds
my $msg = shift;
# let's emulate real human and delay answer
sleep (irand (2) + 1);
for (0..(4 + irand (3))) {
$msg->typing ();
sleep 3;
sleep 3 unless ($_);
}
sleep ( 3 + irand (2));
return;
}
sub IsCensored {
my $msg = shift;
my $forbidden = GetForbiddenTypes ($msg->chat->id);
# voice messages are special
if (defined ($msg->voice) && defined ($msg->voice->duration) && ($msg->voice->duration > 0)) {
if ($forbidden->{'voice'}) {
return 1;
}
}
foreach (keys %{$forbidden}) {
if ($forbidden->{$_} && (defined $msg->{$_})) {
return 1;
}
}
return 0;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

367
lib/BotLib/Admin.pm Normal file
View File

@@ -0,0 +1,367 @@
package BotLib::Admin;
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck croak);
use CHI;
use CHI::Driver::BerkeleyDB;
use BotLib::Conf qw (LoadConf);
use BotLib::Util qw (utf2sha1);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
# to export array we need @ISA here
our @ISA = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA)
our @EXPORT_OK = qw (@ForbiddenMessageTypes @PluginList GetForbiddenTypes AddForbiddenType DelForbiddenType
ListForbidden FortuneToggle FortuneToggleList FortuneStatus PluginToggle PluginStatus
PluginEnabled ChanMsgToggle ChanMsgStatus ChanMsgEnabled);
my $c = LoadConf ();
my $cachedir = $c->{cachedir};
# this list is not yet used
our @PluginList = qw (oboobs obutts); ## no critic (Variables::ProhibitPackageVars)
our @ForbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document); ## no critic (Variables::ProhibitPackageVars)
sub GetForbiddenTypes {
my $chatid = shift;
my $messageTypes;
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
);
foreach (@ForbiddenMessageTypes) {
my $type = $cache->get ($_);
if ($type) {
$messageTypes->{$_} = 1;
} else {
unless (defined $type) {
$cache->set ($_, 0, 'never');
}
$messageTypes->{$_} = 0;
}
}
return $messageTypes;
}
sub AddForbiddenType {
my $chatid = shift;
my $type = shift;
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
);
$cache->set ($type, 1, 'never');
return;
}
sub DelForbiddenType {
my $chatid = shift;
my $type = shift;
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
);
$cache->remove ($type);
return;
}
sub ListForbidden {
my $chatid = shift;
my @list;
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
);
foreach (@ForbiddenMessageTypes) {
my $type = $cache->get ($_);
if ($type) {
push @list, sprintf 'Тип сообщения %s удаляется', $_;
} else {
unless (defined $type) {
$cache->set ($_, 0, 'never');
}
push @list, sprintf 'Тип сообщения %s не удаляется', $_;
}
}
return join "\n", @list;
}
sub FortuneToggle (@) {
my $chatid = shift;
my $action = shift // undef;
my $phrase = 'Фортунка с утра ';
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'fortune'
);
my $state = $cache->get ($chatid);
if (defined $action) {
if ($action) {
$cache->set ($chatid, 1, 'never');
$phrase .= 'будет показываться.';
} else {
if (defined $state) {
$cache->remove ($chatid);
}
$phrase .= 'не будет показываться.';
}
} else {
if (defined $state && $state) {
$cache->remove ($chatid);
$phrase .= 'не будет показываться.';
} else {
$cache->set ($chatid, 1, 'never');
$phrase .= 'будет показываться.';
}
}
return $phrase;
}
sub FortuneStatus ($) {
my $chatid = shift;
my $phrase = 'Фортунка с утра ';
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'fortune'
);
my $state = $cache->get ($chatid);
if (defined $state && $state) {
$phrase .= 'показывается.';
} else {
$phrase .= 'не показывается.';
}
return $phrase;
}
sub FortuneToggleList () {
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'fortune'
);
return $cache->get_keys ();
}
sub ChanMsgToggle (@) {
my $chatid = shift;
my $action = shift // undef;
my $phrase = 'Сообщения, пришедшие от имени каналов ';
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'chan_msg'
);
my $state = $cache->get ($chatid);
if (defined $action) {
if ($action) {
$cache->set ($chatid, 1, 'never');
$phrase .= 'не будут удаляться.';
} else {
if (defined $state && $state) {
$cache->set ($chatid, 0, 'never');
$phrase .= 'будут удаляться.';
} else {
$cache->set ($chatid, 1, 'never');
$phrase .= 'не будут удаляться.';
}
}
} else {
if (defined $state){
if ($state) {
$cache->set ($chatid, 0, 'never');
$phrase .= 'будут удаляться.';
} else {
$cache->set ($chatid, 1, 'never');
$phrase .= 'не будут удаляться.';
}
} else {
$cache->set ($chatid, 1, 'never');
$phrase .= 'не будут удаляться.';
}
}
return $phrase;
}
sub ChanMsgStatus ($) {
my $chatid = shift;
my $phrase = 'Сообщения, пришедшие от имени каналов ';
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'chan_msg'
);
my $state = $cache->get ($chatid);
if (defined $state) {
if ($state) {
$phrase .= 'не удаляются.';
} else {
$phrase .= 'удаляются.';
}
} else {
$phrase .= 'не удаляются.';
}
return $phrase;
}
sub ChanMsgEnabled ($) {
my $chatid = shift;
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'chan_msg'
);
my $state = $cache->get ($chatid);
if (defined $state) {
if ($state) {
return 1;
} else {
return 0;
}
} else {
return 1;
}
}
sub ChanMsgToggleList () {
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'chan_msg'
);
return $cache->get_keys ();
}
sub PluginStatus (@) {
my $chatid = shift;
my $plugin = shift;
my $phrase = "Плагин $plugin ";
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
);
my $state = $cache->get ($plugin);
if ($state) {
$phrase .= 'включён.';
} else {
unless (defined $state) {
$cache->set ($plugin, 0, 'never');
}
$phrase .= 'выключен.';
}
return $phrase;
}
sub PluginEnabled (@) {
my $chatid = shift;
my $plugin = shift;
# seems that we have point to return always true if chat is private
if ($chatid > 0) {
return 1;
}
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
);
my $state = $cache->get ($plugin);
if (defined $state && $state) {
return 1;
} else {
return 0;
}
}
sub PluginToggle (@) {
my $chatid = shift;
my $plugin = shift;
my $action = shift // undef;
my $phrase = "Плагин $plugin ";
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'plugin' . '_' . utf2sha1 ($chatid)
);
my $state = $cache->get ($plugin);
if (defined $action) {
if ($action) {
$cache->set ($plugin, 1, 'never');
$phrase .= 'включён';
} else {
$cache->set ($plugin, 0, 'never');
$phrase .= 'выключен';
}
} else {
if (defined ($state) && $state) {
$cache->set ($plugin, 0, 'never');
$phrase .= 'включён';
} else {
$cache->set ($plugin, 1, 'never');
$phrase .= 'выключен';
}
}
return $phrase;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

40
lib/BotLib/Conf.pm Normal file
View File

@@ -0,0 +1,40 @@
package BotLib::Conf;
# loads config
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use JSON::XS;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (LoadConf);
sub LoadConf {
my $c = 'data/config.json';
open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
my $len = (stat $c) [7];
my $json;
my $readlen = read $CH, $json, $len;
unless ($readlen) {
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATAL] Unable to read $c: $OS_ERROR\n";
}
if ($readlen != $len) {
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATAL] File $c is $len bytes on disk, but we read only $readlen bytes\n";
}
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($json);
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

82
lib/BotLib/Util.pm Normal file
View File

@@ -0,0 +1,82 @@
package BotLib::Util;
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Digest::SHA qw (sha1_base64);
use Encode;
use MIME::Base64;
use Text::Fuzzy qw (distance_edits);
use URI::URL;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (trim urlencode fmatch utf2b64 utf2sha1);
sub trim {
my $str = shift;
if ($str eq '') {
return $str;
}
while (substr ($str, 0, 1) =~ /^\s$/xms) {
$str = substr $str, 1;
}
while (substr ($str, -1, 1) =~ /^\s$/xms) {
chop $str;
}
return $str;
}
sub urlencode {
my $str = shift;
my $urlobj = url $str;
return $urlobj->as_string;
}
sub fmatch {
my $srcphrase = shift;
my $answer = shift;
my ($distance, undef) = distance_edits ($srcphrase, $answer);
my $srcphraselen = length $srcphrase;
my $distance_max = int ($srcphraselen - ($srcphraselen * (100 - (90 / ($srcphraselen ** 0.5))) * 0.01));
if ($distance >= $distance_max) {
return 0;
} else {
return 1;
}
}
sub utf2b64 {
my $string = shift;
if ($string eq '') {
return encode_base64 '';
}
my $bytes = encode_utf8 $string;
return encode_base64 $bytes;
}
sub utf2sha1 {
my $string = shift;
if ($string eq '') {
return sha1_base64 '';
}
my $bytes = encode_utf8 $string;
return sha1_base64 $bytes;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

111
lib/RedisLib.pm Normal file
View File

@@ -0,0 +1,111 @@
package RedisLib;
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use Log::Any qw ($log);
# Чтобы "уж точно" использовать hiredis-биндинги, загрузим этот модуль перед Mojo::Redis
use Protocol::Redis::XS;
use Mojo::Redis;
use Mojo::Redis::Connection;
use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (redis_parse_message redis_events_listener);
my $c = LoadConf ();
sub redis_parse_message {
my $self = shift;
my $m = shift;
my $message;
# Мы "не можем" отправлять сообщения в телеграм, если мы к нему не подключены
# (конечно, можем, но Teapot-lib предполагает, что объектик с чатом - это его собственность, а городить свой что-то
# не очень хочется)
until (defined $main::TGM) {
sleep 1;
}
if ($m->{misc}->{msg_format}) {
$message->{parse_mode} = 'Markdown';
}
$message->{chat_id} = $m->{chatid};
$message->{text} = $m->{message};
if (Teapot::Bot::Object::ChatPermissions::canTalk ($main::TGM, $m->{chatid})) {
# Результат этого действия нас не сильно волнует, т.к. если будет ошибка, то в лог попадёт трейс
$main::TGM->sendMessage ($message);
}
return;
};
sub redis_events_listener {
$log->notice ('[NOTICE]Run redis events listener');
# If we already connected there is no point to disconnect
if (defined $main::REDIS) {
my $connected = eval { Mojo::Redis::Connection->is_connected ($main::REDIS); };
if ($connected) {
$log->notice ('[NOTICE] Redis client already running and connected');
return;
} else {
$log->notice ('[NOTICE] Redis client registered, but looks like it is not connected, try to re-connect');
$main::REDIS = undef;
}
}
my $r = Mojo::Redis->new (
sprintf 'redis://%s:%s/1', $c->{redis_server}, $c->{redis_port}
);
$log->notice ('[NOTICE] New redis client registered, registering callbacks');
# Don't forget to update global ref to our redis context
$main::REDIS = $r;
$r->on (
connection => sub {
my ($redis, $connection) = @_;
$main::RCONN = $connection;
# Log error
$connection->on (
error => sub {
my ($conn, $error) = @_;
$log->error ("[ERROR] Redis connection error: $error");
$main::RCONN = undef;
return;
}
);
return;
}
);
# Subscribe to channels
my $pubsub = $r->pubsub;
my $sub;
my $rpm = \&redis_parse_message;
$log->notice ('[NOTICE] Subscribing to redis channels');
foreach my $channel (@{$c->{redis_channels}}) {
$log->info ("[INFO] Subscribing to $channel");
$sub->{$channel} = $pubsub->json ($channel)->listen (
$channel => sub { $rpm->(@_); }
);
}
return;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

100
lib/Teapot/Bot.pm Normal file
View File

@@ -0,0 +1,100 @@
package Teapot::Bot;
use strict;
use warnings;
$Teapot::Bot::VERSION = '0.022';
# ABSTRACT: A base class to make your very own Telegram bot
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot
=head1 DESCRIPTION
A base class to make your very own Telegram bot
=head1 VERSION
version 0.022
=head1 SYNOPSIS
NOTE: This API should not yet be considered stable.
Creating a bot is easy:
package MyBot;
use Mojo::Base 'Teapot::Bot::Brain';
has token => 'YOURTOKENHERE';
# send a polite reply, to either a group or a single user,
# depending on where we were addressed from
sub _be_polite {
my ($self, $msg) = @_;
return unless $msg->text =~ /hello/;
# is this a 1-on-1 ?
if ($msg->chat->is_user) {
$msg->reply("hello there");
# send them a picture as well
$self->sendPhoto({chat_id => $msg->chat->id, photo => $image_filename});
}
# group chat
else {
$msg->reply("hello to everyone!");
}
}
# setup our bot
sub init {
my $self = shift;
$self->add_listener(\&_be_polite);
}
1;
Now just:
perl -MMyBot -E 'MyBot->new->think'
and you've got yourself a stew, baby! Or a bot, anyway.
Note that for the bot to see messages that do not start with a leading '/', you will need to use
the C<'/setprivacy'> command on Telegram's C<@botfather> interface to change the privacy settings.
=head1 DEPENDENCIES
IO::Socket::SSL
Log::Any
Mojolicious
Test::Exception
=head1 EXAMPLES
This distribution's C<ex/> directory contains some complete examples that may be
instructive to look at.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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

966
lib/Teapot/Bot/Brain.pm Normal file
View File

@@ -0,0 +1,966 @@
package Teapot::Bot::Brain;
# ABSTRACT: A base class to make your very own Telegram bot
use Mojo::Base -base;
use strict;
use warnings;
use English qw ( -no_match_vars );
use Mojo::IOLoop;
use Mojo::UserAgent;
use Carp qw/croak cluck confess/; # use croak where we return error up to app that supply something wrong
# use cluck where we want to say that something bad but non-critical happen in
# lower layer (Mojo loop)
# use confess where we want to say that fatal error happen in lower layer (Mojo loop)
use Log::Any;
use Data::Dumper;
use Teapot::Bot::Object::Message;
use Teapot::Bot::Object::Poll;
use Teapot::Bot::Object::PollAnswer;
use Teapot::Bot::Object::ChatMemberUpdated;
use Teapot::Bot::Object::User;
use Teapot::Bot::Object::Chat;
use Teapot::Bot::Object::ChatMember;
use Teapot::Bot::Object::ChatInviteLink;
$Teapot::Bot::Brain::VERSION = '0.022';
# base class for building telegram robots with Mojolicious
has longpoll_time => 60;
has ua => sub { Mojo::UserAgent->new->inactivity_timeout(shift->longpoll_time + 15) };
has token => sub { croak 'You need to supply your own token'; };
has tasks => sub { [] };
has listeners => sub { [] };
has log => sub { Log::Any->get_logger };
sub add_repeating_task {
my $self = shift;
my $seconds = shift;
my $task = shift;
my $repeater = sub {
# Perform operation every $seconds seconds
my $last_check = time();
Mojo::IOLoop->recurring(0.1 => sub {
my $loop = shift;
my $now = time();
return if ($now - $last_check) < $seconds;
$last_check = $now;
$task->($self);
});
};
# keep a copy
push @{ $self->tasks }, $repeater;
# kick it off
$repeater->();
return;
}
sub add_listener {
my $self = shift;
my $coderef = shift;
push @{ $self->listeners }, $coderef;
return;
}
sub init {
croak 'init() was not overridden!';
}
sub think {
my $self = shift;
$self->init();
$self->_add_getUpdates_handler;
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
return;
}
sub getMe {
my $self = shift;
my $token = $self->token || croak 'No token supplied to getMe()?';
my $url = "https://api.telegram.org/bot${token}/getMe";
my $api_response = $self->_post_request($url);
if ($api_response) {
return Teapot::Bot::Object::User->create_from_hash($api_response, $self);
}
else {
return {'error' => 1};
}
}
sub getChatMember {
my $self = shift;
my $args = shift || {};
my $send_args = {};
unless ($args->{chat_id}) {
cluck 'No chat_id supplied to getChatMember()';
return {'error' => 1};
}
unless ($args->{user_id}) {
cluck 'No user_id supplied to getChatMember()';
return {'error' => 1};
}
$send_args->{chat_id} = $args->{chat_id};
$send_args->{user_id} = $args->{user_id};
my $token = $self->token || croak 'No token supplied to getChatMember?';
my $url = "https://api.telegram.org/bot${token}/getChatMember";
my $api_response = $self->_post_request($url, $send_args);
if ($api_response) {
return Teapot::Bot::Object::ChatMember->create_from_hash($api_response, $self);
}
else {
return {'error' => 1};
}
}
sub banChatMember {
my $self = shift;
my $args = shift || {};
my $token = $self->token || croak 'No token supplied to banChatMember?';
my $send_args = {};
unless ($args->{chat_id}) {
cluck 'No chat_id supplied to banChatMember()';
return {'error' => 1};
}
unless ($args->{user_id}) {
cluck 'No user_id supplied to banChatMember()';
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}/banChatMember";
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;
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}/getChat";
my $api_response = $self->_post_request($url, $send_args);
if ($api_response) {
return Teapot::Bot::Object::Chat->create_from_hash($api_response, $self);
}
else {
return {'error' => 1};
}
}
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 || {};
my $send_args = {};
unless ($args->{chat_id}) {
cluck 'No chat_id supplied in sendMessage()';
return {'error' => 1};
}
$send_args->{chat_id} = $args->{chat_id};
unless ($args->{text}) {
cluck 'No text supplied in sendMessage()';
return {'error' => 1};
}
$send_args->{text} = $args->{text};
# these are optional, send if they are supplied
$send_args->{parse_mode} = $args->{parse_mode} if exists $args->{parse_mode};
$send_args->{disable_web_page_preview} = $args->{disable_web_page_preview} if exists $args->{disable_web_page_preview};
$send_args->{disable_notification} = $args->{disable_notification} if exists $args->{disable_notification};
$send_args->{reply_to_message_id} = $args->{reply_to_message_id} if exists $args->{reply_to_message_id};
# check reply_markup is the right kind
if (exists $args->{reply_markup}) {
my $reply_markup = $args->{reply_markup};
if ( ref($reply_markup) ne 'Teapot::Bot::Object::InlineKeyboardMarkup' &&
ref($reply_markup) ne 'Teapot::Bot::Object::ReplyKeyboardMarkup' &&
ref($reply_markup) ne 'Teapot::Bot::Object::ReplyKeyboardRemove' &&
ref($reply_markup) ne 'Teapot::Bot::Object::ForceReply' ) {
cluck 'Incorrect reply_markup in sendMessage()';
return {'error' => 1};
}
$send_args->{reply_markup} = $reply_markup;
}
my $token = $self->token || croak 'No token supplied to sendMessage()?';
my $url = "https://api.telegram.org/bot${token}/sendMessage";
my $api_response = $self->_post_request($url, $send_args);
if ($api_response) {
return Teapot::Bot::Object::Message->create_from_hash($api_response, $self);
}
else {
return {'error' => 1};
}
}
sub forwardMessage {
my $self = shift;
my $args = shift || {};
my $send_args = {};
unless ($args->{chat_id}) {
cluck 'No chat_id supplied in forwardMessage()';
return {'error' => 1};
}
$send_args->{chat_id} = $args->{chat_id};
unless ($args->{from_chat_id}) {
cluck 'No from_chat_id supplied in forwardMessage()';
return {'error' => 1};
}
$send_args->{from_chat_id} = $args->{from_chat_id};
unless ($args->{message_id}) {
cluck 'No message_id supplied in forwardMessage()';
return {'error' => 1};
}
$send_args->{message_id} = $args->{message_id};
# these are optional, send if they are supplied
$send_args->{disable_notification} = $args->{disable_notification} if exists $args->{disable_notification};
my $token = $self->token || croak 'No token supplied to forwardMessage()?';
my $url = "https://api.telegram.org/bot${token}/forwardMessage";
my $api_response = $self->_post_request($url, $send_args);
if ($api_response) {
return Teapot::Bot::Object::Message->create_from_hash($api_response, $self);
}
else {
return {'error' => 1};
}
}
# TODO: Check that message is no older than 48 hrs
sub deleteMessage {
my $self = shift;
my $args = shift || {};
my $send_args = {};
unless ($args->{chat_id}) {
cluck 'No chat_id supplied in deleteMessage()';
return {'error' => 1};
}
$send_args->{chat_id} = $args->{chat_id};
unless ($args->{message_id}) {
cluck 'No message_id supplied in deleteMessage()';
return {'error' => 1};
}
$send_args->{message_id} = $args->{message_id};
my $token = $self->token || croak 'No token supplied to deleteMessage()?';
if (Teapot::Bot::Object::ChatMember->canDeleteMessage($self, $args->{chat_id})) {
my $url = "https://api.telegram.org/bot${token}/deleteMessage";
$self->_post_request($url, $send_args);
}
else {
return {'error' => 1};
}
return;
}
sub sendPhoto {
my $self = shift;
my $args = shift || {};
my $send_args = {};
unless ($args->{chat_id}) {
cluck 'No chat_id supplied to sendPhoto()';
return {'error' => 1};
}
$send_args->{chat_id} = $args->{chat_id};
# photo can be a string (which might be either a URL for telegram servers
# to fetch, or a file_id string) or a file on disk to upload - we need
# to handle that last case here as it changes the way we create the HTTP
# request
unless ($args->{photo}) {
cluck 'No photo supplied in sendPhoto()';
return {'error' => 1};
}
if (-e $args->{photo}) {
$send_args->{photo} = { file => $args->{photo} };
}
else {
$send_args->{photo} = $args->{photo};
}
my $token = $self->token || croak 'No token in sendPhoto()?';
my $url = "https://api.telegram.org/bot${token}/sendPhoto";
my $api_response = $self->_post_request($url, $send_args);
if ($api_response) {
return Teapot::Bot::Object::Message->create_from_hash($api_response, $self);
}
else {
return {'error' => 1};
}
}
sub sendChatAction {
my $self = shift;
my $args = shift || {};
my $send_args = {};
unless ($args->{chat_id}) {
cluck 'No chat_id supplied in sendChatAction()';
return {'error' => 1};
}
$send_args->{chat_id} = $args->{chat_id};
unless (defined $args->{action}) {
$args->{action} = 'typing';
$send_args->{action} = 'typing';
}
if ($args->{action} eq 'upload_photo') {
$send_args->{action} = 'upload_photo';
}
elsif ($args->{action} eq 'record_video') {
$send_args->{action} = 'record_video';
}
elsif ($args->{action} eq 'upload_video') {
$send_args->{action} = 'upload_video';
}
elsif ($args->{action} eq 'record_voice') {
$send_args->{action} = 'record_voice';
}
elsif ($args->{action} eq 'upload_voice') {
$send_args->{action} = 'upload_voice';
}
elsif ($args->{action} eq 'upload_document') {
$send_args->{action} = 'upload_document';
}
elsif ($args->{action} eq 'find_location') {
$send_args->{action} = 'find_location';
}
elsif ($args->{action} eq 'record_video_note') {
$send_args->{action} = 'record_video_note';
}
elsif ($args->{action} eq 'upload_video_note') {
$send_args->{action} = 'upload_video_note';
}
elsif ($args->{action} eq 'choose_sticker') {
$send_args->{action} = 'choose_sticker';
}
else {
$send_args->{action} = 'typing';
}
my $token = $self->token || croak 'No token in sendChatAction()?';
my $url = "https://api.telegram.org/bot${token}/sendChatAction";
my $api_response = $self->_post_request ($url, $send_args);
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;
my $http_active = 0;
my $last_update_id = -1;
my $token = $self->token;
Mojo::IOLoop->recurring(0.1 => sub {
# do nothing if our previous longpoll is still going
return if $http_active;
my $offset = $last_update_id + 1;
my $updateURL = "https://api.telegram.org/bot${token}/getUpdates?offset=${offset}&timeout=60";
$http_active = 1;
$self->ua->get($updateURL => sub {
my ($ua, $tx) = @_;
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;
});
});
return;
}
# process a message which arrived via getUpdates
sub _process_message {
my $self = shift;
my $item = shift;
my $update_id = $item->{update_id};
# 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};
# 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
if (! $update) {
cluck 'Do not know how to handle this update: ' . Dumper($item);
return;
}
foreach my $listener (@{ $self->listeners }) {
# call the listener code, supplying ourself and the update
my $evalRet = eval {
$listener->($self, $update);
return 1;
};
unless ($evalRet) {
cluck "An error occured during update processing: $EVAL_ERROR";
return;
}
}
return;
}
sub _post_request {
my $self = shift;
my $url = shift;
my $form_args = shift || {};
my $res = $self->ua->post($url, form => $form_args)->result;
if ($res->is_success) {
return $res->json->{result};
}
elsif ($res->is_error) {
# This can be non-fatal error: api change.
cluck 'Failed to post: ' . $res->message;
return 0; # to handle this as false in upper layers
}
else {
# This must be something fatal for sure, because either is_success or is_error must be set by Mojo
confess 'Not sure what went wrong';
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Brain - A base class to make your very own Telegram bot
=head1 VERSION
version 0.022
=head1 SYNOPSIS
package MyApp::Coolbot;
use Mojo::Base 'Teapot::Bot::Brain';
has token => 'token-you-got-from-@botfather';
sub init {
my $self = shift;
$self->add_repeating_task(600, \&timed_task);
$self->add_listener(\&respond_to_messages);
}
Elsewhere....
my $bot = MyApp::Coolbot->new();
$bot->think; # this will block unless there is already an event
# loop running
=head1 DESCRIPTION
This base class makes it easy to create your own Bot classes that
interface with the Telegram Bot API.
Internally it uses the Mojo::IOLoop event loop to provide non-blocking
access to the Bot API, allowing your bot to listen for events via the
longpoll getUpdates API method and also trigger timed events that can
run without blocking.
As with any bot framework, the principle is that the framework allows you
to interact with other users on Telegram. The Telegram API provides a rich
set of typed objects. This framework will allow you to create those objects
to send into the API (for instance, sending text messages, sending photos,
and more) as well as call your code (via L<add_listener> when your bot
receives messages (which might be text, or images, and so on).
How bots work with Telegram is out of scope for this document, a good
starting place is L<https://core.telegram.org/bots>.
=head1 METHODS
=head2 add_repeating_task
This method will add a sub to run every C<$seconds> seconds. Pass this method
two parameters, the number of seconds between executions, and the coderef to
execute.
Your coderef will be passed the L<Teapot::Bot::Brain> object when it is
executed.
=head2 add_listener
Respond to messages we receive. It takes a single argument, a coderef to execute
for each update that is sent to us. These are *typically* C<Teapot::Bot:Object::Message>
objects, though that is not the only type of update that may be sent (see
L<https://core.telegram.org/bots/api#update>).
Multiple listeners can be added, they will receive the incoming update in the order
that they are registered.
Any or all listeners can choose to ignore or take action on any particular update.
=head2 think
Start this bot thinking.
Calls your init method and then enters a blocking loop (unless a Mojo::IOLoop
is already running).
=head2 getMe
This is the wrapper around the C<getMe> API method. See
L<https://core.telegram.org/bots/api#getme>.
Takes no arguments, and returns the L<Teapot::Bot::Object::User> that
represents this bot.
On error returns hash reference with error set to 1
=head2 getChatMember
This is the wrapper around the C<getChatMember> API method. See
L<https://core.telegram.org/bots/api#getchatmember>.
Takes chat_id, and user_id as arguments.
Returns the L<Teapot::Bot::Object::ChatMember> that represents properties
of Chat User.
On error returns hash reference with error set to 1
=head2 banChatMember
This is the wrapper around the C<banChatMember> API method. See
L<https://core.telegram.org/bots/api#banchatmember>.
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
L<https://core.telegram.org/bots/api#getchat>.
Takes chat_id as argument.
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>.
Returns a L<Teapot::Bot::Object::Message> object.
On error returns hash reference with error set to 1
=head2 forwardMessage
See L<https://core.telegram.org/bots/api#forwardmessage>.
Returns a L<Teapot::Bot::Object::Message> object.
On error returns hash reference with error set to 1
=head2 deleteMessage
See L<https://core.telegram.org/bots/api#deletemessage>.
Returns a L<Teapot::Bot::Object::Message> object.
On error returns hash reference with error set to 1
=head2 sendPhoto
See L<https://core.telegram.org/bots/api#sendphoto>.
Returns a L<Teapot::Bot::Object::Message> object.
On error returns hash reference with error set to 1
=head2 sendChatAction
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
=item *
L<Mojolicious>
=item *
L<https://core.telegram.org/bots>
=back
=head1 Telegram Bot API methods
The following methods are relatively thin wrappers around the various
methods available in the Telgram Bot API to send messages and perform other
updates.
L<https://core.telegram.org/bots/api#available-methods>
They all return immediately with the corresponding Teapot::Bot::Object
subclass - consult the documenation for each below to see what to expect.
Note that not all methods have yet been implemented.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,61 @@
package Teapot::Bot::Object::Animation;
# ABSTRACT: The base class for Telegram message 'Animation' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::PhotoSize;
use Carp qw/croak/;
$Teapot::Bot::Object::Animation::VERSION = '0.022';
has 'file_id';
has 'file_unique_id';
has 'width';
has 'height';
has 'duration';
has 'thumb'; #PhotoSize
has 'file_name';
has 'mime_type';
has 'file_size';
sub fields {
return { scalar => [qw/file_id file_unique_id width height duration file_name mime_type
file_size/],
'Teapot::Bot::Object::PhotoSize' => [qw/thumb/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Animation - The base class for Telegram message 'Animation' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'Animation' type.
See L<https://core.telegram.org/bots/api#animation> for details of the
attributes available for L<Teapot::Bot::Object::Animation> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,58 @@
package Teapot::Bot::Object::Audio;
# ABSTRACT: The base class for Telegram 'Audio' type objects
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'; # 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 file_unique_id duration performer title file_name mime_type
file_size/],
'Teapot::Bot::Object::PhotoSize' => [qw/thumb/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Audio - The base class for Telegram 'Audio' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Audio' type objects.
See L<https://core.telegram.org/bots/api#audio> for details of the
attributes available for L<Teapot::Bot::Object::Audio> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,233 @@
package Teapot::Bot::Object::Base;
# ABSTRACT: The base class for all Teapot::Bot::Object objects.
use Mojo::Base -base;
use List::Util qw/any/;
use Carp qw/croak cluck/;
use Data::Dumper;
$Teapot::Bot::Object::Base::VERSION = '0.022';
has '_brain'; # a reference to our brain
sub arrays { return qw// } # override if needed
sub _field_is_array {
my $self = shift;
my $field = shift;
unless (defined $field) {
return;
}
if (any { /^$field$/ } $self->arrays) {
return 1;
}
return;
}
sub array_of_arrays { return qw// } #override if needed
sub _field_is_array_of_arrays {
my $self = shift;
my $field = shift;
unless (defined $field) {
return;
}
if (any { /^$field$/ } $self->array_of_arrays) {
return 1;
}
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 ($array);
return $obj;
}
cluck "Dumping class: " . Dumper ($class);
cluck "Dumping array: " . Dumper ($array);
# it's stub, return $obj
return $obj;
}
# create an object from a hash. Needs to deal with the nested types, and
# arrays
sub create_from_hash {
my $class = shift;
my $hash = shift;
my $brain = shift || croak 'No brain supplied to create_from_hash()';
my $obj = $class->new(_brain => $brain);
unless (defined $hash) {
cluck 'Hash is undef';
return $obj;
}
unless (ref ($hash) eq 'HASH') {
if (ref ($hash) eq 'ARRAY') {
return create_from_array($class, $hash, $brain);
}
cluck 'Not a hash ' . Dumper ($hash);
return $obj;
}
# 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;
}
sub as_hashref {
my $self = shift;
my $hash = {};
# add the simple scalar values
foreach my $type ( keys %{ $self->fields }) {
my @fields = @{ $self->fields->{$type} };
foreach my $field (@fields) {
if ($type eq 'scalar') {
$hash->{$field} = $self->$field;
}
else {
# non array types
$hash->{$field} = $self->$field->as_hashref
if (ref($self->$field) ne 'ARRAY' && defined $self->$field);
# array types
$hash->{$field} = [
map { $_->as_hashref } @{ $self->$field }
] if (ref($self->$field) eq 'ARRAY');
}
}
}
return $hash;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Base - The base class for all Telegram::Bot::Object objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for all Telegram::Bot::Object objects.
This class should not be instantiated itself. Instead, instantiate a sub-class.
You should generally not need to instantiate objects of sub-classes of L<Teapot::Bot::Object::Base>,
instead the appropriate objects will be created from an incoming request via
L<Teapot::Bot::Brain>.
You can then use the methods referenced below on those objects.
=head1 METHODS
=head2 arrays
Should be overridden by subclasses, returning an array listing of which fields
for the object are arrays.
=head2 array_of_arrays
Should be overridden by subclasses, returning an array listing od which fields
for the object are arrays of arrays.
=head2 create_from_hash
Create an object of the appropriate class, including any sub-objects of
other types, as needed.
=head2 as_hashref
Return this object as a hashref.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,47 @@
package Teapot::Bot::Object::CallbackGame;
# ABSTRACT: The base class for Telegram message 'CallbackGame' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::CallbackGame::VERSION = '0.022';
# https://core.telegram.org/bots/api#callbackgame
# "A placeholder, currently holds no information. Use BotFather to set up your game"
sub fields {
return { },
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::CallbackGame - The base class for Telegram message 'CallbackGame' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'CallbackGame' type.
See L<https://core.telegram.org/bots/api#callbackgame> for details of the
attributes available for L<Teapot::Bot::Object::CallbackGame> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,104 @@
package Teapot::Bot::Object::Chat;
# ABSTRACT: The base class for Telegram 'Chat' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::ChatPhoto;
use Teapot::Bot::Object::Message;
use Teapot::Bot::Object::ChatPermissions;
use Teapot::Bot::Object::ChatLocation;
$Teapot::Bot::Object::Chat::VERSION = '0.022';
has 'id';
has 'type';
has 'title'; # Optional.
has 'username'; # Optional.
has 'first_name'; # Optional.
has 'last_name'; # Optional.
has 'photo'; # Teapot::Bot::Object::ChatPhoto. Optional. Returned only in getChat.
has 'bio'; # Optional. Bio of the other party in a private chat. Returned only in getChat.
has 'has_private_forwards'; # Optional. True, if privacy settings of the other party in the private chat allows to
# use tg://user?id=<user_id> links only in chats with the user.
# Returned only in getChat.
has 'description'; # Optional. Returned only in getChat.
has 'invite_link'; # Optional. Returned only in getChat.
has 'pinned_message'; # Teapot::Bot::Object::Message
has 'permissions'; # Teapot::Bot::Object::ChatPermissions. Optional. Default chat member permissions, for
# groups and supergroups. Returned only in getChat.
has 'slow_mode_delay'; # Optional. Returned only in getChat.
has 'message_auto_delete_time'; # Optional. The time after which all messages sent to the chat will be automatically
# deleted; in seconds. Returned only in getChat.
has 'has_protected_content'; # Optional. True, if messages from the chat can't be forwarded to other chats.
# Returned only in getChat.
has 'sticker_set_name'; # Optional. Returned only in getChat.
has 'can_set_sticker_set'; # Optional. Returned only in getChat.
has 'linked_chat_id'; # Optional. greater than 32 bits, smaller than 52 bits
has 'location'; # Optional. Returned only in getChat.
sub fields {
return {
'scalar' => [qw/id type title username first_name last_name bio
has_private_forwards description invite_link slow_mode_delay
message_auto_delete_time has_protected_content
sticker_set_name can_set_sticker_set linked_chat_id/],
'Teapot::Bot::Object::ChatPhoto' => [qw/photo/],
'Teapot::Bot::Object::Message' => [qw/pinned_message/],
'Teapot::Bot::Object::ChatPermissions' => [qw/permissions/],
'Teapot::Bot::Object::ChatLocation' => [qw/location/],
};
}
sub is_user {
return shift->id > 0;
}
sub is_group {
return shift->id < 0;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Chat - The base class for Telegram 'Chat' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Chat' type objects.
See L<https://core.telegram.org/bots/api#chat> for details of the
attributes available for L<Teapot::Bot::Object::Chat> objects.
=head1 METHODS
=head2 is_user
Returns true is this is a chat is a single user.
=head2 is_group
Returns true if this is a chat is a group.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,61 @@
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 'creates_join_request';
has 'is_primary';
has 'is_revoked';
has 'name';
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
has 'pending_join_request_count';
sub fields {
return {
'scalar' => [qw/invite_link creates_join_request is_primary is_revoked name expire_date
member_limit pending_join_request_count/],
'Teapot::Bot::Object::User' => [qw/creator/],
};
}
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

@@ -0,0 +1,51 @@
package Teapot::Bot::Object::ChatLocation;
# ABSTRACT: The base class for Telegram message 'ChatLocation' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::ChatLocation::VERSION = '0.022';
has 'location';
has 'address';
sub fields {
return {
'Teapot::Bot::Object::Location' => [qw/location/],
'scalar' => [qw/address/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::ChatLocation - The base class for Telegram message 'ChatLocation' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'ChatLocation' type.
See L<https://core.telegram.org/bots/api#chatlocation> for details of the
attributes available for L<Teapot::Bot::Object::ChatLocation> objects.
=head1 AUTHOR
Sergei Fedosov <eleksir@gmail.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 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,168 @@
package Teapot::Bot::Object::ChatMember;
# ABSTRACT: The base class for Telegram 'ChatMember' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::User;
use Carp qw(cluck);
$Teapot::Bot::Object::ChatMember::VERSION = '0.022';
# ChatMemberOwner
has 'user';
has 'status';
has 'custom_title'; # optional. Owner and administrators only.
has 'is_anonymous'; # Optional. Owner and administrators only.
# ChatMemberAdministrator
# has 'user';
# has 'status';
has 'can_be_edited'; # optional. Administrators only.
# has 'custom_title'; # optional. Owner and administrators only.
# has 'is_anonymous'; # Optional. Owner and 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.
has 'can_invite_users'; # optional. Administrators and restricted only.
has 'can_pin_messages'; # optional. Administrators and restricted only.
# ChatMemberMember
# has 'status';
# has 'user';
# ChatMemberRestricted
# has 'status';
# has 'user';
has 'is_member'; # optional. Restricted only.
# has 'can_change_info'; # optional. Administrators and restricted only.
# has 'can_invite_users'; # optional. Administrators and restricted only.
# has 'can_pin_messages'; # optional. Administrators and restricted only.
has 'can_send_messages'; # optional. Restricted only.
has 'can_send_media_messages'; # optional. Restricted only.
has 'can_send_polls'; # optional. Restricted only.
has 'can_send_other_messages'; # optional. Restricted only.
has 'can_add_web_page_previews'; # optional. Restricted only.
has 'until_date'; # optional. Restricted and kicked only.
# ChatMemberLeft
# has 'status';
# has 'user';
# ChatMemberBanned
# has 'status';
# has 'user';
# has 'until_date'; # optional. Restricted and kicked only.
sub fields {
return {
'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/],
};
}
sub canDeleteMessage {
my $self = shift;
my $chatid = shift;
my $can_delete = 0;
if ($chatid < 0) {
# group chat
my $chatobj = $self->getChat ({ 'chat_id' => $chatid });
# on api error, keep silence
unless ($chatobj) {
cluck "Unable to get chat info for $chatid from telegram API";
return 0;
}
my $myObj = $self->getMe ();
# on api error, keep silence
unless ($chatobj) {
cluck "Unable to get chat info for $chatid from telegram API";
return 0;
}
my $myid = $myObj->id;
my $me = $self->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
# on api error, keep silence
unless ($me) {
cluck 'Unable to get chat info for bot itself from telegram API';
return 0;
}
# bot can delete msg if it is group and it is admin there.
if ($chatobj->{'type'} eq 'group') {
if ($me->{'status'} eq 'administrator') {
$can_delete = 1;
}
# in supergroup bot must be granted with can_delete_messages
} elsif (($chatobj->{'type'} eq 'supergroup') || ($chatobj->{'type'} eq 'channel')) {
if ($me->{'can_delete_messages'}) {
$can_delete = 1;
}
}
} else {
# 1 on 1 chat with user
$can_delete = 1;
}
return $can_delete;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::ChatMember - The base class for Telegram 'ChatMember' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'ChatMember' type objects.
See L<https://core.telegram.org/bots/api#chatmember> for details of the
attributes available for L<Teapot::Bot::Object::ChatMember> objects.
=head1 METHODS
=head2 canDeleteMessage
A convenience method to check if bot can delete message in given conversation.
Returns true if the bot can delete the message in given conversation, otherwise false.
=head1 AUTHOR
Sergei Fedosov <eleksir@gmail.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2020 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,67 @@
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;
use Teapot::Bot::Object::Voice;
$Teapot::Bot::Object::ChatMemberUpdated::VERSION = '0.022';
has 'chat';
has 'from';
has 'date';
has 'old_chat_member';
has 'new_chat_member';
has 'text'; # Undocumented as of Bot API 5.2
has 'voice'; # Undocumented as of Bot API 5.2
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 text/],
'Teapot::Bot::Object::ChatMember' => [qw/old_chat_member new_chat_member/],
'Teapot::Bot::Object::Voice' => [qw/voice/],
'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

@@ -0,0 +1,119 @@
package Teapot::Bot::Object::ChatPermissions;
# ABSTRACT: The base class for Telegram 'ChatPermissions' type objects
use Carp qw(carp);
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::ChatPermissions::VERSION = '0.022';
# all fields are optional
# N.B. Some of the fields "overlaps" other, so in order to guess valid set of permissions you should check all of them
has 'can_send_messages'; # True, if the user is allowed to send text messages, contacts, locations and venues
has 'can_send_media_messages'; # True, if the user is allowed to send audios, documents, photos, videos, video notes
# and voice notes, implies can_send_messages
has 'can_send_polls'; # True, if the user is allowed to send polls, implies can_send_messages
has 'can_send_other_messages'; # True, if the user is allowed to send animations, games, stickers and use inline bots,
# implies can_send_media_messages
has 'can_add_web_page_previews'; # True, if the user is allowed to add web page previews to their messages, implies
# can_send_media_messages
has 'can_change_info'; # True, if the user is allowed to change the chat title, photo and other settings.
# Ignored in public supergroups
has 'can_invite_users'; # True, if the user is allowed to invite new users to the chat
has 'can_pin_messages'; # True, if the user is allowed to pin messages. Ignored in public supergroups
sub fields {
return {
'scalar' => [qw/can_send_messages can_send_media_messages can_send_polls
can_send_other_messages can_add_web_page_previews can_change_info
can_invite_users can_pin_messages/]
};
}
sub canTalk {
my $self = shift;
my $chatid = shift;
my $can_talk = 0;
if ($chatid < 0) {
# group chat
my $chatobj = $self->_brain->getChat ({ 'chat_id' => $chatid });
# on api error, keep silence
unless ($chatobj) {
carp "Unable to get chat info for $chatid from telegram API";
return 0;
}
my $myObj = $self->_brain->getMe ();
# on api error, keep silence
unless ($chatobj) {
carp "Unable to get chat info for $chatid from telegram API";
return 0;
}
my $myid = $myObj->id;
my $me = $self->_brain->getChatMember ({ 'chat_id' => $chatid, 'user_id' => $myid });
# on api error, keep silence
unless ($me) {
carp 'Unable to get chat info for bot itself from telegram API';
return 0;
}
if ($me->{'status'} eq 'administrator') {
$can_talk = 1;
} else {
my $group_talk = int ($chatobj->{permissions}->{can_send_messages});
$can_talk = $group_talk;
}
} else {
# 1 on 1 chat with user
$can_talk = 1;
}
return $can_talk;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::ChatPermissions - The base class for Telegram 'ChatPermissions' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'ChatPermissions' type objects.
See L<https://core.telegram.org/bots/api#chatpermissions> for details of the
attributes available for L<Teapot::Bot::Object::ChatPermissions> objects.
=head1 METHODS
=head2 canTalk
A convenience method to check if bot can talk in given conversation.
Returns true if the bot can talk in given conversation, otherwise false.
=head1 AUTHOR
Sergei Fedosov <eleksir@gmail.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2020 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,52 @@
package Teapot::Bot::Object::ChatPhoto;
# ABSTRACT: The base class for Telegram 'ChatPhoto' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::ChatPhoto::VERSION = '0.022';
has 'small_file_id';
has 'small_file_unique_id';
has 'big_file_id';
has 'big_file_unique_id';
sub fields {
return {
'scalar' => [qw/small_file_id small_file_unique_id big_file_id big_file_unique_id/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::ChatPhoto - The base class for Telegram 'ChatPhoto' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'ChatPhoto' type objects.
See L<https://core.telegram.org/bots/api#chatphoto> for details of the
attributes available for L<Teapot::Bot::Object::ChatPhoto> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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::Contact;
# ABSTRACT: The base class for Telegram 'Contact' objects.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::Contact::VERSION = '0.022';
has 'phone_number';
has 'first_name';
has 'last_name';
has 'user_id';
has 'vcard';
sub fields {
return {
scalar => [qw/phone_number first_name last_name user_id vcard/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Contact - The base class for Telegram 'Contact' objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Contact' objects.
See L<https://core.telegram.org/bots/api#contact> for details of the
attributes available for L<Teapot::Bot::Object::Contact> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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::Dice;
# ABSTRACT: The base class for Telegram message 'Dice' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::Dice::VERSION = '0.022';
has 'emoji';
has 'value';
sub fields {
return { scalar => [qw/emoji value/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Dice - The base class for Telegram message 'Dice' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'Dice' type.
See L<https://core.telegram.org/bots/api#dice> for details of the
attributes available for L<Teapot::Bot::Object::dice> objects.
=head1 AUTHOR
Sergei Fedosov <eleksir@gmail.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 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,57 @@
package Teapot::Bot::Object::Document;
# ABSTRACT: The base class for Telegram 'Document' objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::PhotoSize;
$Teapot::Bot::Object::Document::VERSION = '0.022';
has 'file_id';
has 'file_unique_id';
has 'thumb'; #PhotoSize
has 'file_name';
has 'mime_type';
has 'file_size';
sub fields {
return {
scalar => [qw/file_id file_unique_id file_name mime_type file_size/],
'Teapot::Bot::Object::PhotoSize' => [qw/thumb/]
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Document - The base class for Telegram 'Document' objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Document' objects.
See L<https://core.telegram.org/bots/api#document> for details of the
attributes available for L<Teapot::Bot::Object::Document> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,49 @@
package Teapot::Bot::Object::EncryptedCredentials;
# ABSTRACT: The base class for Telegram 'EncryptedCredentials' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::EncryptedCredentials::VERSION = '0.022';
has 'data';
has 'hash';
has 'secret';
sub fields {
return { 'scalar' => [qw/ data hash secret/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::EncryptedCredentials - The base class for Telegram 'EncryptedCredentials' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'EncryptedCredentials' type objects.
See L<https://core.telegram.org/bots/api#encryptedcredentials> for details of the
attributes available for L<Teapot::Bot::Object::EncryptedCredentials> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,57 @@
package Teapot::Bot::Object::EncryptedPassportElement;
# ABSTRACT: The base class for Telegram 'EncryptedPassportElement' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::EncryptedPassportElement::VERSION = '0.022';
# XXX Implement rest of this
# https://core.telegram.org/bots/api#encryptedpassportelement
has 'type';
has 'data';
has 'phone_number';
has 'email';
# XXX more here
sub fields {
return { 'scalar' => [qw/type data phone_number email/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::EncryptedPassportElement - The base class for Telegram 'EncryptedPassportElement' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'EncryptedPassportElement' type objects.
See L<https://core.telegram.org/bots/api#encryptedpassportelement> for details of the
attributes available for L<Teapot::Bot::Object::EncryptedPassportElement> objects.
Note that this type is not yet fully implemented.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,63 @@
package Teapot::Bot::Object::Game;
# ABSTRACT: The base class for Telegram message 'Game' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::PhotoSize;
use Teapot::Bot::Object::Animation;
use Teapot::Bot::Object::MessageEntity;
$Teapot::Bot::Object::Game::VERSION = '0.022';
has 'title';
has 'description';
has 'photo'; # Array of PhotoSize
has 'text';
has 'text_entities'; #Array of MessageEntity
has 'animation'; #Animation
sub fields {
return {
scalar => [qw/title description text/],
'Teapot::Bot::Object::PhotoSize' => [qw/photo/],
'Teapot::Bot::Object::MessageEntity' => [qw/text_entities/],
'Teapot::Bot::Object::Animation' => [qw/animation/],
};
}
sub arrays { return qw/photo text_entities/; }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Game - The base class for Telegram message 'Game' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'Game' type.
See L<https://core.telegram.org/bots/api#game> for details of the
attributes available for L<Teapot::Bot::Object::Game> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,60 @@
package Teapot::Bot::Object::InlineKeyboardButton;
# ABSTRACT: The base class for Telegram 'InlineKeyboardButton' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::LoginUrl;
use Teapot::Bot::Object::CallbackGame;
$Teapot::Bot::Object::InlineKeyboardButton::VERSION = '0.022';
has 'text';
has 'url';
has 'login_url'; #LoginUrl
has 'callback_data';
has 'switch_inline_query';
has 'switch_inline_query_current_chat';
has 'callback_game'; # CallbackGame
has 'pay';
sub fields {
return { 'scalar' => [qw/text url callback_data switch_inline_query
switch_inline_query_current_chat pay/],
'Teapot::Bot::Object::LoginUrl' => [qw/login_url/],
'Teapot::Bot::Object::CallbackGame' => [qw/callback_game/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::InlineKeyboardButton - The base class for Telegram 'InlineKeyboardButton' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'InlineKeyboardButton' type objects.
See L<https://core.telegram.org/bots/api#inlinekeyboardbutton> for details of the
attributes available for L<Teapot::Bot::Object::InlineKeyboardButton> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,52 @@
package Teapot::Bot::Object::InlineKeyboardMarkup;
# ABSTRACT: The base class for Telegram 'InlineKeyboardMarkup' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::InlineKeyboardButton;
$Teapot::Bot::Object::InlineKeyboardMarkup::VERSION = '0.022';
has 'inline_keyboard';
sub fields {
return { 'Teapot::Bot::Object::InlineKeyboardButton' => [qw/inline_keyboard/] };
}
sub array_of_arrays {
return qw/inline_keyboard/;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::InlineKeyboardMarkup - The base class for Telegram 'InlineKeyboardMarkup' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'InlineKeyboardMarkup' type objects.
See L<https://core.telegram.org/bots/api#inlinekeyboardmarkup> for details of the
attributes available for L<Teapot::Bot::Object::InlineKeyboardMarkup> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,51 @@
package Teapot::Bot::Object::Invoice;
# ABSTRACT: The base class for Telegram 'Invoice' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::Invoice::VERSION = '0.022';
has 'title';
has 'description';
has 'start_parameter';
has 'currency';
has 'total_amount';
sub fields {
return { scalar => [qw/title description start_parameter currency total_amount/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Invoice - The base class for Telegram 'Invoice' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Invoice' type objects.
See L<https://core.telegram.org/bots/api#invoice> for details of the
attributes available for L<Teapot::Bot::Object::Invoice> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,52 @@
package Teapot::Bot::Object::Location;
# ABSTRACT: The base class for Telegram message 'Location' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::Location::VERSION = '0.022';
has 'longitude';
has 'latitude';
has 'horizontal_accuracy';
has 'live_period';
has 'heading';
has 'proximity_alert_radius';
sub fields {
return { scalar => [qw/longitude latitude horizontal_accuracy live_period heading proximity_alert_radius/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Location - The base class for Telegram message 'Location' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'Location' type.
See L<https://core.telegram.org/bots/api#location> for details of the
attributes available for L<Teapot::Bot::Object::Location> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,50 @@
package Teapot::Bot::Object::LoginUrl;
# ABSTRACT: The base class for Telegram 'LoginUrl' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::LoginUrl::VERSION = '0.022';
has 'url';
has 'forward_text';
has 'bot_username';
has 'request_write_access';
sub fields {
return { 'scalar' => [qw/url forward_text bot_username request_write_access/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::LoginUrl - The base class for Telegram 'LoginUrl' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'LoginUrl' type objects.
See L<https://core.telegram.org/bots/api#loginurl> for details of the
attributes available for L<Teapot::Bot::Object::LoginUrl> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,245 @@
package Teapot::Bot::Object::Message;
# ABSTRACT: The base class for the Telegram type "Message".
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::User;
use Teapot::Bot::Object::Chat;
use Teapot::Bot::Object::ChatMember;
use Teapot::Bot::Object::ChatPermissions;
use Teapot::Bot::Object::MessageEntity;
use Teapot::Bot::Object::Audio;
use Teapot::Bot::Object::Document;
use Teapot::Bot::Object::Animation;
use Teapot::Bot::Object::Game;
use Teapot::Bot::Object::PhotoSize;
use Teapot::Bot::Object::Sticker;
use Teapot::Bot::Object::Video;
use Teapot::Bot::Object::Voice;
use Teapot::Bot::Object::VideoNote;
use Teapot::Bot::Object::Contact;
use Teapot::Bot::Object::Location;
use Teapot::Bot::Object::Poll;
use Teapot::Bot::Object::Location;
use Teapot::Bot::Object::PhotoSize;
use Teapot::Bot::Object::Invoice;
use Teapot::Bot::Object::Venue;
use Teapot::Bot::Object::SuccessfulPayment;
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::VoiceChatScheduled;
use Teapot::Bot::Object::VoiceChatStarted;
use Teapot::Bot::Object::VoiceChatEnded;
use Teapot::Bot::Object::VoiceChatParticipantsInvited;
use Data::Dumper;
use Carp qw(cluck);
$Teapot::Bot::Object::Message::VERSION = '0.022';
# basic message stuff
has 'message_id';
has 'from'; # User
has 'sender_chat'; # Chat
has 'date';
has 'chat'; # Chat
has 'forward_from'; # User
has 'forward_from_chat'; # Chat
has 'forward_from_message_id';
has 'forward_signature';
has 'forward_sender_name';
has 'forward_date';
has 'is_automatic_forward';
has 'reply_to_message'; # Message
has 'via_bot'; # User
has 'edit_date';
has 'has_protected_content';
has 'media_group_id';
has 'author_signature';
has 'text';
has 'entities'; # Array of MessageEntity
has 'animation'; # Animation
has 'audio'; # Audio
has 'document'; # Document
has 'photo'; # Array of PhotoSize
has 'sticker'; # Sticker
has 'video'; # Video
has 'video_note'; # VideoNote
has 'voice'; # Voice
has 'caption';
has 'caption_entities'; # Array of MessageEntity
has 'contact'; # Contact
has 'dice';
has 'game';
has 'poll'; # Poll
has 'venue'; # Venue
has 'location'; # Location
has 'new_chat_members'; # Array of User
has 'left_chat_member'; # User
has 'new_chat_title';
has 'new_chat_photo'; # Array of PhotoSize
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
has 'invoice'; # Invoice
has 'successful_payment'; # SuccessfulPayment
has 'connected_website';
has 'passport_data'; # PassportData
has 'proximity_alert_triggered';
has 'voice_chat_scheduled'; # Optional. Service message: voice chat scheduled
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 {
return {
'scalar' => [qw/message_id date forward_from_message_id
forward_signature forward_sender_name
forward_date is_automatic_forward edit_date has_protected_content
media_group_id author_signature text caption
new_chat_title delete_chat_photo
group_chat_created supergroup_chat_created
channel_chat_created migrate_to_chat_id
migrate_from_chat_id connected_website/],
'Teapot::Bot::Object::User' => [qw/from forward_from via_bot new_chat_members left_chat_member /],
'Teapot::Bot::Object::Chat' => [qw/sender_chat chat forward_from_chat/],
'Teapot::Bot::Object::Message' => [qw/reply_to_message pinned_message/],
'Teapot::Bot::Object::MessageEntity' => [qw/entities caption_entities /],
'Teapot::Bot::Object::Audio' => [qw/audio/],
'Teapot::Bot::Object::Document' => [qw/document/],
'Teapot::Bot::Object::Animation' => [qw/animation/],
'Teapot::Bot::Object::Game' => [qw/game/],
'Teapot::Bot::Object::PhotoSize' => [qw/photo new_chat_photo/],
'Teapot::Bot::Object::Sticker' => [qw/sticker/],
'Teapot::Bot::Object::Video' => [qw/video/],
'Teapot::Bot::Object::Voice' => [qw/voice/],
'Teapot::Bot::Object::VideoNote' => [qw/video_note/],
'Teapot::Bot::Object::Contact' => [qw/contact/],
'Teapot::Bot::Object::Location' => [qw/location/],
'Teapot::Bot::Object::Venue' => [qw/venue/],
'Teapot::Bot::Object::Poll' => [qw/poll/],
'Teapot::Bot::Object::Invoice' => [qw/invoice/],
'Teapot::Bot::Object::SuccessfulPayment' => [qw/successful_payment/],
'Teapot::Bot::Object::PassportData' => [qw/passport_data/],
'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::VoiceChatScheduled' => [qw/voice_chat_scheduled/],
'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/],
};
}
sub arrays {
return qw/photo entities caption_entities new_chat_members new_chat_photo/;
}
sub reply {
my $self = shift;
my $text = shift;
my $chatid = $self->chat->id;
if (Teapot::Bot::Object::ChatPermissions::canTalk($self, $chatid)) {
return $self->_brain->sendMessage({chat_id => $chatid, text => $text});
}
return {'error' => 1};
}
sub replyMd {
my $self = shift;
my $text = shift;
my $chatid = $self->chat->id;
if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) {
my $send_args;
$send_args->{text} = $text;
$send_args->{parse_mode} = 'Markdown';
$send_args->{chat_id} = $chatid;
return $self->_brain->sendMessage($send_args);
}
return {'error' => 1};
}
sub typing {
my $self = shift;
my $chatid = $self->chat->id;
if (Teapot::Bot::Object::ChatPermissions::canTalk ($self, $chatid)) {
return $self->_brain->sendChatAction({chat_id => $chatid});
}
return {'error' => 1};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Message - The base class for the Telegram type "Message"
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for the Telegram type "Message".
See L<https://core.telegram.org/bots/api#message> for details of the
attributes available for L<Teapot::Bot::Object::Message> objects.
=head1 METHODS
=head2 reply
A convenience method to reply to a message with text.
Will return the L<Teapot::Bot::Object::Message> object representing the message
sent.
=head2 typing
Sends notification to chat that bot is "typing" something.
Returns nothing that should be checked.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,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

@@ -0,0 +1,56 @@
package Teapot::Bot::Object::MessageEntity;
# ABSTRACT: The base class for Telegram 'MessageEntity' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::User;
$Teapot::Bot::Object::MessageEntity::VERSION = '0.022';
has 'type';
has 'offset';
has 'length';
has 'url'; # Optional.
has 'user'; # Optional. Teapot::Bot::Object::User
has 'language'; # Optional. For “pre” only, the programming language of the entity text
sub fields {
return {
'scalar' => [qw/type offset length url language/],
'Teapot::Bot::Object::User' => [qw/user/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::MessageEntity - The base class for Telegram 'MessageEntity' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'MessageEntity' type objects.
See L<https://core.telegram.org/bots/api#messageentity> for details of the
attributes available for L<Teapot::Bot::Object::MessageEntity> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,57 @@
package Teapot::Bot::Object::PassportData;
# ABSTRACT: The base class for Telegram 'PassportData' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::EncryptedPassportElement;
use Teapot::Bot::Object::EncryptedCredentials;
$Teapot::Bot::Object::PassportData::VERSION = '0.022';
has 'data'; # Array of EncryptedPassportElement
has 'credentials'; # EncryptedCredentials
sub fields {
return {
'Teapot::Bot::Object::EncryptedPassportElement' => [qw/data/],
'Teapot::Bot::Object::EncryptedCredentials' => [qw/credentials/],
};
}
sub arrays {
return qw/data/;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::PassportData - The base class for Telegram 'PassportData' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'PassportData' type objects.
See L<https://core.telegram.org/bots/api#passportdata> for details of the
attributes available for L<Teapot::Bot::Object::PassportData> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,52 @@
package Teapot::Bot::Object::PhotoSize;
# ABSTRACT: The base class for Telegram message 'PhotoSize' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
use Carp qw/croak/;
$Teapot::Bot::Object::PhotoSize::VERSION = '0.022';
has 'file_id';
has 'file_unique_id';
has 'width';
has 'height';
has 'file_size';
sub fields {
return { scalar => [qw/file_id file_unique_id width height file_size/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::PhotoSize - The base class for Telegram message 'PhotoSize' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'PhotoSize' type.
See L<https://core.telegram.org/bots/api#photosize> for details of the
attributes available for L<Teapot::Bot::Object::PhotoSize> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,69 @@
package Teapot::Bot::Object::Poll;
# ABSTRACT: The base class for Telegram 'Poll' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::PollOption;
$Teapot::Bot::Object::Poll::VERSION = '0.022';
has 'id';
has 'question';
has 'options'; # Array of PollOption
has 'total_voter_count';
has 'is_closed';
has 'is_anonymous';
has 'type';
has 'allows_multiple_answers';
has 'correct_option_id';
has 'explanation';
has 'explanation_entities';
has 'open_period';
has 'close_date';
sub fields {
return {
scalar => [qw/id question total_voter_count is_closed is_anonymous type
allows_multiple_answers correct_option_id explanation
explanation_entities open_period close_date/],
'Teapot::Bot::Object::PollOption' => [qw/options/],
};
}
sub arrays {
return qw/options explanation_entities/;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Poll - The base class for Telegram 'Poll' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Poll' type objects
See L<https://core.telegram.org/bots/api#poll> for details of the
attributes available for L<Teapot::Bot::Object::Poll> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,56 @@
package Teapot::Bot::Object::PollAnswer;
# ABSTRACT: The base class for Telegram 'PollOption' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::PollAnswer::VERSION = '0.022';
has 'poll_id';
has 'user';
has 'option_ids';
sub fields {
return {
'scalar' => [qw/poll_id option_ids/],
'Teapot::Bot::Object::User' => [qw/user/],
};
}
sub arrays {
return qw/option_ids/;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::PollAnswer - The base class for Telegram 'PollAnswer' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'PollAnswer' type objects.
See L<https://core.telegram.org/bots/api#pollanswer> for details of the
attributes available for L<Teapot::Bot::Object::PollAnswer> objects.
=head1 AUTHOR
Sergei Fedosov <eleksir@gmail.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2021 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::PollOption;
# ABSTRACT: The base class for Telegram 'PollOption' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::PollOption::VERSION = '0.022';
has 'text';
has 'voter_count';
sub fields {
return { scalar => [qw/text voter_count/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::PollOption - The base class for Telegram 'PollOption' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'PollOption' type objects.
See L<https://core.telegram.org/bots/api#polloption> for details of the
attributes available for L<Teapot::Bot::Object::PollOption> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,52 @@
package Teapot::Bot::Object::ProximityAlertTriggered;
# ABSTRACT: The base class for Telegram message 'ProximityAlertTriggered' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::ProximityAlertTriggered::VERSION = '0.022';
has 'traveler'; # User
has 'watcher'; # User
has 'distance';
sub fields {
return {
'Teapot::Bot::Object::User' => [qw/traveler watcher/],
'scalar' => [qw/distance/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::ProximityAlertTriggered - The base class for Telegram message 'ProximityAlertTriggered' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'ProximityAlertTriggered' type.
See L<https://core.telegram.org/bots/api#proximityalerttriggered> for details of the
attributes available for L<Teapot::Bot::Object::ProximityAlertTriggered> objects.
=head1 AUTHOR
Sergei Fedosov <eleksir@gmail.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2020 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,58 @@
package Teapot::Bot::Object::Sticker;
# ABSTRACT: The base class for Telegram message 'Sticker' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::PhotoSize;
$Teapot::Bot::Object::Sticker::VERSION = '0.022';
has 'file_id';
has 'width';
has 'height';
has 'thumb'; # PhotoSize
has 'emoji';
has 'set_name';
# has 'mask_position'; # XXX TODO
has 'file_size';
sub fields {
return {
scalar => [ qw/file_id width height emoji set_name file_size/ ],
'Teapot::Bot::Object::PhotoSize' => [ qw/thumb/ ],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Sticker - The base class for Telegram message 'Sticker' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'Sticker' type.
See L<https://core.telegram.org/bots/api#sticker> for details of the
attributes available for L<Teapot::Bot::Object::Sticker> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,58 @@
package Teapot::Bot::Object::SuccessfulPayment;
# ABSTRACT: The base class for Telegram 'SuccessfulPayment' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
# use Teapot::Bot::Object::OrderInfo;
$Teapot::Bot::Object::SuccessfulPayment::VERSION = '0.022';
has 'currency';
has 'total_amount';
has 'invoice_payload';
has 'shipping_option_id';
# has 'order_info'; #OrderInfo XXX
has 'telegram_payment_charge_id';
has 'provider_payment_charge_id';
sub fields {
return {
scalar => [qw/currency total_amount invoice_payload shipping_option_id
telegram_payment_charge_id provider_payment_charge_id/],
# 'Teapot::Bot::Object::OrderInfo' => [qw/order_info/],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::SuccessfulPayment - The base class for Telegram 'SuccessfulPayment' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'SuccessfulPayment' type objects.
See L<https://core.telegram.org/bots/api#successfulpayment> for details of the
attributes available for L<Teapot::Bot::Object::SuccessfulPayment> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,59 @@
package Teapot::Bot::Object::User;
# ABSTRACT: The base class for Telegram message 'User' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::User::VERSION = '0.022';
has 'id';
has 'is_bot';
has 'first_name';
has 'last_name'; # optional
has 'username'; # optional
has 'language_code'; # optional
has 'can_join_groups'; # optional, only for getMe() method
has 'can_read_all_group_messages';# optional, only for getMe() method
has 'supports_inline_queries'; # optional, only for getMe() method
sub fields {
return {
scalar => [qw/id is_bot first_name last_name username language_code can_join_groups
can_read_all_group_messages supports_inline_queries/]
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::User - The base class for Telegram message 'User' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'User' type.
See L<https://core.telegram.org/bots/api#user> for details of the
attributes available for L<Teapot::Bot::Object::User> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,58 @@
package Teapot::Bot::Object::Venue;
# ABSTRACT: The base class for Telegram 'LoginUrl' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::Location;
$Teapot::Bot::Object::Venue::VERSION = '0.022';
has 'location'; #Location
has 'title';
has 'address';
has 'foursquare_id';
has 'foursquare_type';
has 'google_place_id';
has 'google_place_type';
sub fields {
return {
'scalar' => [qw/title address foursquare_id foursquare_type google_place_id google_place_type/],
'Teapot::Bot::Object::Location' => [qw/location/]
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Venue - The base class for Telegram 'LoginUrl' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'LoginUrl' type objects.
See L<https://core.telegram.org/bots/api#venue> for details of the
attributes available for L<Teapot::Bot::Object::Venue> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,60 @@
package Teapot::Bot::Object::Video;
# ABSTRACT: The base class for Telegram 'Video' object.
use Mojo::Base 'Teapot::Bot::Object::Base';
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'; # 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 file_unique_id width height duration file_name mime_type
file_size/],
'Teapot::Bot::Object::PhotoSize' => [qw/thumb/]
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Video - The base class for Telegram 'Video' object
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Video' object.
See L<https://core.telegram.org/bots/api#video> for details of the
attributes available for L<Teapot::Bot::Object::Video> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,58 @@
package Teapot::Bot::Object::VideoNote;
# ABSTRACT: The base class for Telegram 'VideoNote' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
use Teapot::Bot::Object::PhotoSize;
$Teapot::Bot::Object::VideoNote::VERSION = '0.022';
has 'file_id';
has 'file_unique_id';
has 'length';
has 'duration';
has 'mime_type';
has 'thumb'; #PhotoSize
has 'file_size';
sub fields {
return {
scalar => [qw/file_id file_unique_id length duration mime_type file_size/],
'Teapot::Bot::Object::PhotoSize' => [qw/thumb /],
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::VideoNote - The base class for Telegram 'VideoNote' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'VideoNote' type object.
See L<https://core.telegram.org/bots/api#videonote> for details of the
attributes available for L<Teapot::Bot::Object::VideoNote> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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,51 @@
package Teapot::Bot::Object::Voice;
# ABSTRACT: The base class for Telegram 'Voice' type objects
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::Voice::VERSION = '0.022';
has 'file_id';
has 'file_unique_id';
has 'duration';
has 'mime_type';
has 'file_size';
sub fields {
return { scalar => [qw/file_id file_unique_id duration mime_type file_size/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::Voice - The base class for Telegram 'Voice' type objects
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram 'Voice' type objects.
See L<https://core.telegram.org/bots/api#voice> for details of the
attributes available for L<Teapot::Bot::Object::Voice> objects.
=head1 AUTHOR
Justin Hawkins <justin@eatmorecode.com>
=head1 LICENSE AND COPYRIGHT
This software is copyright (c) 2019 by Justin Hawkins.
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::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 'duration';
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::VoiceChatScheduled;
# ABSTRACT: The base class for Telegram message 'VoiceChatEnded' type.
use Mojo::Base 'Teapot::Bot::Object::Base';
$Teapot::Bot::Object::VoiceChatScheduled::VERSION = '0.022';
# This object represents a service message about a voice chat started in the chat. Currently holds no information.
has 'start_date';
sub fields {
return { scalar => [qw/start_date/] };
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Teapot::Bot::Object::VoiceChatScheduled - The base class for Telegram message 'VoiceChatScheduled' type
=head1 VERSION
version 0.022
=head1 DESCRIPTION
The base class for Telegram message 'VoiceChatScheduled' type.
See L<https://core.telegram.org/bots/api#voicechatscheduled> for details of the
attributes available for L<Teapot::Bot::Object::VoiceChatScheduled> 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

419
lib/TelegramBot.pm Normal file
View File

@@ -0,0 +1,419 @@
package TelegramBot;
# main bot gears are here
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck carp);
use Clone qw (clone);
use File::Path qw (make_path);
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use Mojo::Base 'Teapot::Bot::Brain';
use BotLib::Admin qw (FortuneToggleList ChanMsgEnabled);
use BotLib qw (Command Highlight BotSleep IsCensored);
use BotLib::Conf qw (LoadConf);
use BotLib::Util qw (trim fmatch);
use RedisLib qw (redis_parse_message redis_events_listener);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (RunTelegramBot);
my $c = LoadConf ();
my $myid;
my $myusername;
my $myfirst_name;
my $mylast_name;
my $myfullname;
has token => $c->{telegrambot}->{token};
my $redismsg->{from} = 'telegram';
$redismsg->{plugin} = 'telegram';
$redismsg->{misc}->{answer} = 1;
$redismsg->{misc}->{csign} = $c->{telegrambot}->{csign};
$redismsg->{misc}->{msg_format} = 0;
$redismsg->{misc}->{fwd_cnt} = 1;
sub __cron {
my $self = shift;
my $rmsg = clone ($redismsg);
$rmsg->{mode} = 'public';
# Press 'F' to pay respect
$rmsg->{message} = sprintf '%sf', $c->{telegrambot}->{csign};
$rmsg->{misc}->{good_morning} = 1;
$rmsg->{misc}->{msg_format} = 1;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time);
{
do {
my $ready = eval { $main::RCONN->is_connected; };
last if ($ready);
} while (sleep 1);
}
my $pubsub = $main::REDIS->pubsub;
if ($hour == 8 && ($min >= 0 && $min <= 14)) {
foreach my $enabledfortunechat (FortuneToggleList ()) {
$rmsg->{userid} = $enabledfortunechat;
$rmsg->{chatid} = $enabledfortunechat;
$pubsub->json ($c->{'redis_router_channel'})->notify (
$c->{'redis_router_channel'} => $rmsg
);
}
}
return;
}
sub __on_msg {
my ($self, $msg) = @_;
# chat info
my $chatid;
my $chatname = 'Noname chat';
# user sending message info
my ($userid, $username, $fullname, $highlight, $vis_a_vi) = BotLib::Highlight ($msg);
my $csign = $c->{telegrambot}->{csign};
unless ($myid) {
my $myObj = $self->getMe ();
unless ($myObj) {
$log->error ('[ERROR] Unable to get chatid, API Error?');
return;
}
$myid = $myObj->id;
$myusername = $myObj->username;
$myfirst_name = $myObj->first_name;
$mylast_name = $myObj->last_name;
if (defined ($myfirst_name) && ($myfirst_name ne '') && defined ($mylast_name) && ($mylast_name ne '')) {
$myfullname = $myfirst_name . ' ' . $mylast_name;
} elsif (defined ($myfirst_name) && ($myfirst_name ne '')) {
$myfullname = $myfirst_name;
} elsif (defined ($mylast_name) && ($mylast_name ne '')) {
$myfullname = $mylast_name;
} else {
$myfullname = $myusername;
}
}
if ($msg->chat->can ('id') && defined ($msg->chat->id)) {
$chatid = $msg->chat->id;
if ($msg->chat->can ('username') && defined ($msg->chat->username)) {
$chatname = $msg->chat->username ;
} else {
if ($msg->chat->can ('title') && defined ($msg->chat->title)) {
$chatname = $msg->chat->title;
} else {
$chatname = 'Noname chat';
}
}
} else {
$log->warn ('[INFO] Unable to get chatid');
return;
}
my $phrase = '';
# Newcommer event, greet our new member and suggest to introduce themself.
if ($msg->can ('new_chat_members') && defined ($msg->new_chat_members)) {
my @members;
my @introduce = (
'Дратути',
'Дарована',
'Доброе утро, день или вечер',
'Добро пожаловать в наше скромное коммунити',
'Наше вам с кисточкой тут, на канальчике',
);
foreach my $member (@{$msg->new_chat_members}) {
my $member_str = '';
# avoid naming people by spacing symbols, or empty names
if ($member->can ('first_name') && defined ($member->first_name) && $member->first_name !~ /^\s+$/ui) {
$member_str .= $member->first_name;
if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
$member_str .= ' ' . $member->last_name;
}
} else {
if ($member->can ('last_name') && defined ($member->last_name) && $member->last_name !~ /^\s+$/ui) {
$member_str .= ' ' . $member->last_name;
# username must be uniq and should contain only english letters and numbers, so...
} elsif ($member->can ('username') && defined ($member->username)) {
$member_str .= '@' . $member->username;
# fallback to id if uose trying to be smartass and use only spacing chars in it's firstname and/or lastname
} else {
$member_str .= $member->id;
}
}
push @members, sprintf '[%s](tg://user?id=%s)', $member_str, $member->id;
};
if ($#members > 1) {
my $lastone = pop @members;
$phrase = sprintf '%s, %s и %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $introduce[irand ($#introduce + 1)], join (', ', @members), $lastone;
} else {
$phrase = sprintf '%s, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $introduce[irand ($#introduce + 1)], $members[0];
}
BotSleep $msg;
$msg->replyMd ($phrase);
return;
}
# is this a 1-on-1 ?
if ($msg->chat->type eq 'private') {
unless (defined $msg->text) {
return;
}
my $text = $msg->text;
$log->debug (sprintf ('[DEBUG] Private chat %s say to bot: %s', $vis_a_vi, $text));
# Ответ по-умолчанию
my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.';
if (substr ($text, 0, 1) eq $csign) {
# Если текст похож на команду, усылаем его в BotLib.pm
$reply = Command ($self, $msg, $text, $userid);
} else {
my $rmsg = clone ($redismsg);
$rmsg->{mode} = 'private';
$rmsg->{message} = $text;
$rmsg->{userid} = $userid;
$rmsg->{chatid} = $userid;
my $pubsub = $main::REDIS->pubsub;
$pubsub->json ($c->{'redis_router_channel'})->notify (
$c->{'redis_router_channel'} => $rmsg
);
return;
}
# Команды раздела Admin ответ таки возвращают
if (defined $reply) {
$msg->typing ();
sleep 1;
$log->debug (sprintf ('[DEBUG] Private chat bot reply to %s: %s', $vis_a_vi, $reply));
$msg->reply ($reply);
}
# group chat
} elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
my $reply;
# Некоторые виды сообщений можно "зацензурить" ботом, например, голосовые сообщения, картинки итд.
# И вот тут как раз такая проверка и происходит
if (IsCensored $msg) {
$log->info (sprintf '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi);
$self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});
}
# Некоторые рекламные товарищи пытаются срать своими каналами в чятик это тоже можно зацензурить ботом и это
# пидорство он будет удалять asap
# 136817688 - это специальный id пользователя, который принимает облик канала, на него можно нажать и попасть
# на рекламируемый канал
if ($msg->from->id == 136817688) {
my $sender_chat = eval { $msg->sender_chat->id };
if (defined $sender_chat) {
unless (ChanMsgEnabled ($chatid)) {
$self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});
}
}
}
# Если обнаруживаем здесь сообщение без текста, просто ничего не делаем и выходим из процедуры обработки
# сообщения
unless (defined $msg->text) {
$log->debug (sprintf ('[DEBUG] No text in message from %s', $vis_a_vi));
return;
}
# Текст есть, потенциально можно будет поболтать!
my $text = $msg->text;
$log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text));
# Если это ответ на сообщение, то вдруг, на наше?
if (defined ($msg->reply_to_message) &&
defined ($msg->reply_to_message->from) &&
defined ($msg->reply_to_message->from->username) &&
($msg->reply_to_message->from->username eq $myusername)) {
$log->debug (sprintf ('[DEBUG] In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi));
# Если новый участник чата ответил на наше приветствие, проигнорируем его ответ (и попробуем сойти за
# человека :)
if (substr ($msg->reply_to_message->text, -61) eq 'Представьтес, пожалуйста, и расскажите, что вас сюда привело.') {
my $match = 0;
my @hello = (
'Дратути, ',
'Дарована, ',
'Доброе утро, день или вечер, ',
'Добро пожаловать в наше скромное коммунити, ',
'Наше вам с кисточкой тут, на канальчике, '
);
foreach my $hi (@hello) {
if (substr ($msg->reply_to_message->text, 0, length $hi) eq $hi) {
return;
}
}
}
# На всякий случай, попробуем убрать наше имя из фразы.
my $pat1 = quotemeta ('@' . $myusername);
my $pat2 = quotemeta $myfullname;
$phrase = $text;
$phrase =~ s/$pat1//g;
$phrase =~ s/$pat2//g;
# Попробуем сгенерить ответ
my $rmsg = clone ($redismsg);
$rmsg->{mode} = 'public';
$rmsg->{message} = $phrase;
$rmsg->{userid} = $userid;
$rmsg->{chatid} = $chatid;
my $pubsub = $main::REDIS->pubsub;
$pubsub->json ($c->{'redis_router_channel'})->notify (
$c->{'redis_router_channel'} => $rmsg
);
return;
# Если текст похож на команду, усылаем его в BotLib.pm
} elsif (substr ($text, 0, 1) eq $csign) {
$reply = Command ($self, $msg, $text, $chatid);
# Похоже кто-то написал наше имя в чятике, но ничего не захотел дописывать к нему
} elsif (
($text eq $myusername) or
($text eq '@' . $myusername) or
($text eq '@' . $myusername . ' ') or
($text eq $myfullname) or
($text eq $myfullname . ' ')
) {
$reply = 'Чего?';
# А тут кто-то к нам обратился с чем-то по имени
} else {
my $qname = quotemeta ('@' . $myusername);
my $qtname = quotemeta $myfullname;
my $rmsg = clone ($redismsg);
$rmsg->{mode} = 'public';
$rmsg->{userid} = $userid;
$rmsg->{chatid} = $chatid;
# Сообщение обращено к боту
if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){
$phrase = $1;
$rmsg->{message} = $phrase;
# Бота упомянули по имени
} elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) {
$phrase = $text;
$rmsg->{message} = $phrase;
# Бота упомянули по телеграммному имени
} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
$phrase = $text;
$rmsg->{message} = $phrase;
} else {
$rmsg->{message} = $text;
$rmsg->{misc}->{answer} = 0;
}
my $pubsub = $main::REDIS->pubsub;
$pubsub->json ($c->{'redis_router_channel'})->notify (
$c->{'redis_router_channel'} => $rmsg
);
return;
}
if (defined ($reply) && $reply ne '') {
# work a bit more on input phrase
$phrase = trim $phrase;
while ($phrase =~ /[\.|\,|\?|\!]$/) {
chop $phrase;
}
$phrase = lc $phrase;
if (fmatch (lc ($reply), $phrase)) {
$reply = RandomCommonPhrase ();
}
$msg->typing ();
sleep (irand 2);
$log->debug (sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply));
$msg->reply ($reply);
} else {
$log->debug (sprintf ('[DEBUG] In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi));
}
# should be channel, so we can't talk
} else {
return;
}
return;
}
sub RandomCommonPhrase {
my @myphrase = (
'Так, блядь...',
'*Закатывает рукава* И ради этого ты меня позвал?',
'Ну чего ты начинаешь, нормально же общались',
'Повтори свой вопрос, не поняла',
'Выйди и зайди нормально',
'Я подумаю',
'Даже не знаю, что на это ответить',
'Ты упал такие вопросы девочке задавать?',
'Можно и так, но не уверена',
'А как ты думаешь?',
'А ви, таки, почему интересуетесь?',
);
return $myphrase[irand ($#myphrase + 1)];
}
# setup our bot
sub init {
my $self = shift;
# Don't forget to update global ref to our telegram context
$main::TGM = $self;
$self->add_listener (\&__on_msg);
$self->add_repeating_task (900, \&__cron);
redis_events_listener ();
return;
}
sub RunTelegramBot {
while (sleep 3) {
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
TelegramBot->new->think;
}
}
return;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4:

View File

@@ -1,239 +0,0 @@
package botlib;
use 5.018;
use strict;
use warnings "all";
use utf8;
use open qw(:std :utf8);
use HTTP::Tiny;
use URI::URL;
use JSON::XS qw(decode_json encode_json);
use Digest::MD5 qw(md5_base64);
use DB_File;
use conf qw(loadConf);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT = qw(weather logger trim randomCommonPhrase);
$VERSION = "1.0";
my $c = loadConf();
sub weather($) {
my $city = shift;
while (substr($city, -1) eq "\n") { chomp($city); }
while (substr($city, 0, 1) eq "\n") { $city = substr($city, 1); }
return "Мне нужно ИМЯ города." if ($city eq '');
return "Длинновато для названия города." if (length($city) > 80);
$city = ucfirst($city);
my $w = __weather($city);
my $reply;
if ($w) {
if ($w->{temperature_min} == $w->{temperature_max}) {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name},
$w->{country},
ucfirst($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
$w->{temperature_feelslike},
$w->{humidity},
$w->{pressure}
);
} else {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name},
$w->{country},
ucfirst($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
$w->{temperature_max},
$w->{temperature_feelslike},
$w->{humidity},
$w->{pressure}
);
}
} else {
$reply = "Я не знаю, какая погода в $city";
}
return $reply;
}
sub __weather($) {
my $city = shift;
$city = __urlencode($city);
my $id = md5_base64($city);
my $appid = $c->{openweathermap}->{appid};
my $now = time();
my $fc;
my $w;
# attach to cache data
tie my %cachetime, 'DB_File', $c->{openweathermap}->{cachetime} or do {
warn "Something nasty happen when cachetime ties to its data: $!";
return undef;
};
tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do {
warn "Something nasty happen when cachedata ties to its data: $!";
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 (my $counter = 0; $counter < 3; $counter++) {
next if ($r->{success});
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));
sleep 2;
}
# all 3 times can give error, so check it here
if ($r->{success}) {
$fc = eval { decode_json($r->{content}) };
if ($@) {
warn "[WARN] openweathermap returns corrupted json: $@";
untie %cachetime;
untie %cachedata;
return undef;
};
$cachetime{$id} = $now;
$cachedata{$id} = encode_json($fc);
} else {
untie %cachetime;
untie %cachedata;
return undef;
}
}
untie %cachetime;
untie %cachedata;
# TODO: check all of this for existance
$w->{'name'} = $fc->{name};
$w->{'state'} = $fc->{state};
$w->{'country'} = $fc->{sys}->{country};
$w->{'longitude'} = $fc->{coord}->{lon};
$w->{'latitude'} = $fc->{coord}->{lat};
$w->{'temperature_min'} = int($fc->{main}->{temp_min} - 273.15);
$w->{'temperature_max'} = int($fc->{main}->{temp_max} - 273.15);
$w->{'temperature_feelslike'} = int($fc->{main}->{feels_like} - 273.15);
$w->{'humidity'} = $fc->{main}->{humidity};
$w->{'pressure'} = int($fc->{main}->{pressure} * 0.75006375541921);
$w->{'description'} = $fc->{weather}->[0]->{description};
$w->{'wind_speed'} = $fc->{wind}->{speed};
$w->{'wind_direction'} = 'разный';
my $dir = int($fc->{wind}->{deg} + 0);
if ($dir == 0) {
$w->{'wind_direction'} = 'северный';
} elsif ($dir > 0 && $dir <= 30) {
$w->{'wind_direction'} = 'северо-северо-восточный';
} elsif ($dir > 30 && $dir <= 60) {
$w->{'wind_direction'} = 'северо-восточный';
} elsif ($dir > 60 && $dir < 90) {
$w->{'wind_direction'} = 'восточно-северо-восточный';
} elsif ($dir == 90) {
$w->{'wind_direction'} = 'восточный';
} elsif ($dir > 90 && $dir <= 120) {
$w->{'wind_direction'} = 'восточно-юго-восточный';
} elsif ($dir > 120 && $dir <= 150) {
$w->{'wind_direction'} = 'юговосточный';
} elsif ($dir > 150 && $dir < 180) {
$w->{'wind_direction'} = 'юго-юго-восточный';
} elsif ($dir == 180) {
$w->{'wind_direction'} = 'южный';
} elsif ($dir > 180 && $dir <= 210) {
$w->{'wind_direction'} = 'юго-юго-западный';
} elsif ($dir > 210 && $dir <= 240) {
$w->{'wind_direction'} = 'юго-западный';
} elsif ($dir > 240 && $dir < 270) {
$w->{'wind_direction'} = 'западно-юго-западный';
} elsif ($dir == 270) {
$w->{'wind_direction'} = 'западный';
} elsif ($dir > 270 && $dir <= 300) {
$w->{'wind_direction'} = 'западно-северо-западный';
} elsif ($dir > 300 && $dir <= 330) {
$w->{'wind_direction'} = 'северо-западный';
} elsif ($dir > 330 && $dir < 360) {
$w->{'wind_direction'} = 'северо-северо-западный';
} elsif ($dir == 360) {
$w->{'wind_direction'} = 'северный';
}
return $w;
}
sub __urlencode($) {
my $str = shift;
my $urlobj = url $str;
$str = $urlobj->as_string;
$urlobj = undef; undef $urlobj;
return $str;
}
sub logger {
my $msg = shift;
if ($c->{debug_log}) {
my $mode = '>';
$mode = '>>' if (-f $c->{debug_log});
if (open (LOG, $mode, $c->{debug_log})) {
print LOG $msg . "\n";
close LOG;
}
}
}
sub trim($) {
my $str = shift;
while (substr ($str, 0, 1) =~ /^\s$/) {
$str = substr($str, 1);
}
while (substr ($str, -1, 1) =~ /^\s$/) {
chop ($str);
}
return $str;
}
sub randomCommonPhrase() {
my @myphrase = (
"Так, блядь...",
"*Закатывает рукава* И ради этого ты меня позвал?",
"Ну чего ты начинаешь, нормально же общались",
"Повтори свой вопрос, не поняла",
"Выйди и зайди нормально",
"Я подумаю",
"Даже не знаю что на это ответить",
"Ты упал такие вопросы девочке задавать?",
"Можно и так, но не уверена",
"А как ты думаешь?"
);
return ($myphrase[rand($#myphrase -1)]);
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

View File

@@ -1,69 +0,0 @@
package conf;
use 5.018;
use strict;
use warnings "all";
use utf8;
use open qw(:std :utf8);
use vars qw/$VERSION/;
use Fcntl qw(O_WRONLY O_CREAT O_TRUNC);
use JSON::XS qw(decode_json encode_json);
use Exporter qw(import);
our @EXPORT = qw(loadConf saveConf);
$VERSION = "1.0";
sub loadConf ();
sub saveConf ($);
sub loadConf () {
my $c = "data/config.json";
open (C, "<", $c) or die "[FATA] No conf at $c: $!\n";
my $len = (stat ($c)) [7];
my $json;
my $readlen = read (C, $json, $len);
unless ($readlen) {
close C;
die "[FATA] Unable to read $c: $!\n";
}
if ($readlen != $len) {
close C;
die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n";
}
close C;
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($json);
}
sub saveConf($) {
my $c = shift;
my $file = "data/myapi.json";
my $j = JSON::XS->new->pretty->canonical->indent (1);
my $json = $j->encode ($c);
$j = undef; undef $j;
use bytes;
my $len = length ($json);
no bytes;
# TODO: make it transactional
sysopen (C, $file, O_WRONLY|O_CREAT|O_TRUNC) or die "[FATA] Unable to open $file: $!\n";
my $written = syswrite (C, $json, $len);
unless (defined ($written)) {
die "[FATA] Unable to write to $file: $!";
}
unless ($written != $len) {
die "[FATA] We wrote $written bytes to $file, bu buffer length id $len bytes\n";
}
close C;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

View File

@@ -1,293 +0,0 @@
package telegrambot;
use 5.018;
use strict;
use warnings "all";
use vars qw/$VERSION/;
use utf8;
use Data::Dumper;
use open qw(:std :utf8);
use File::Path qw( mkpath );
use Hailo;
use Encode;
use Mojo::Base 'Telegram::Bot::Brain';
use conf;
use botlib;
use Exporter qw(import);
our @EXPORT = qw(run_telegrambot);
$VERSION = "1.0";
my $c = loadConf();
my $hailo;
my $myid;
# guess it later
my $can_talk = 0;
has token => $c->{telegrambot}->{token};
sub __cron {
my $self = shift;
# noop
return;
}
sub __on_msg {
my ($self, $msg) = @_;
unless ($myid) {
my $myObj = Telegram::Bot::Brain::getMe($self);
$myid = $myObj->id;
}
if ($msg->{'chat'}->can('id')) {
my $chatid = $msg->{'chat'}->id;
my $group_talk = 0;
# because of bot api restriction there is no events about changing permissions in chat sent to bot
# so before sending any answer, we should check if we can do so
# N.B. there is situation when we do not recieve any messages from chat: if we are in exception list, even if it allows any kind of events for bot
# If we are just member of chat, it looks like we obey general chat restrictions, so we need only to query getChat in this case
# If we admin, we can get|send messages even if group by itself disallows it.
# works only for public chats, so id shoud be < 0.
if ($chatid < 0) {
my $chatobj = getChat ($self, $chatid);
# actually evaluates to 1 for true and to 0 for false
$group_talk = int ($chatobj->{permissions}->{can_send_messages});
}
my $chatObj = getChatMember ($self, $chatid, $myid);
if ($chatObj->{'status'} eq 'administrator') {
$can_talk = 1;
} else {
$can_talk = $group_talk;
}
}
my $phrase;
if (($msg->{'new_chat_members'}) && $can_talk) {
# we have newcommers here
my $newcommer;
if ($msg->{'new_chat_members'}->can('first_name')) {
$newcommer .= $msg->{'new_chat_members'}->first_name;
if ($msg->{'new_chat_members'}->can('last_name')) {
$newcommer .= ' ' . $msg->{'new_chat_members'}->last_name;
}
} elsif ($msg->{'new_chat_members'}->can('last_name')) {
$newcommer .= $msg->{'new_chat_members'}->last_name;
} elsif ($msg->{'new_chat_members'}->can('username')) {
$newcommer .= $msg->{'new_chat_members'}->username;
}
if ($newcommer) {
$msg->reply("Дратути, $newcommer. Представьтес, пожалуйста, и расскажите, что вас сюда привело.");
} else {
$msg->reply("Дратути. Представьтес, пожалуйста, и расскажите, что вас сюда привело.");
}
return;
}
# lazy init chat-bot brains
unless (defined($hailo->{$msg->chat->id})) {
$hailo->{$msg->chat->id} = Hailo->new(
# we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite
brain => sprintf("%s/%s.brain.sqlite", $c->{telegrambot}->{braindir}, $msg->chat->id),
order => 3
);
}
# is this a 1-on-1 ?
if ($msg->chat->type eq 'private') {
return unless(defined($msg->text));
my $text = $msg->text;
my $csign = quotemeta($c->{telegrambot}->{csign});
my $reply;
if (substr($text, 0, 1) eq $c->{telegrambot}->{csign}) {
if (substr($text, 1) eq "ping") {
$reply = "Pong.";
} elsif (substr($text, 1) eq "пинг") {
$reply = "Понг.";
} elsif (substr($text, 1, 1) eq 'w' || substr($text, 1, 1) eq 'п') {
my $city = substr($text, 2);
$reply = weather($city);
} else {
$reply = "Чего?";
}
} else {
$reply = $hailo->{$msg->chat->id}->learn_reply($text);
}
if (defined($reply) && $reply ne '') {
$msg->reply($reply);
logger ("private chat reply: $reply");
} else {
# if we have no answer, say something default in private chat
$msg->reply("Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.");
}
# group chat
} elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
my $reply;
return unless(defined($msg->text));
my $text = $msg->text;
# sometimes shit happens?
return unless(defined($text));
my $qname = quotemeta($c->{telegrambot}->{name});
my $qtname = quotemeta($c->{telegrambot}->{tname});
my $csign = quotemeta($c->{telegrambot}->{csign});
# simple commands
if (substr($text, 0, 1) eq $c->{telegrambot}->{csign}) {
if (substr($text, 1) eq "help") {
$reply = '```
!help | !помощь - список команд
!w город | !п город - погода в указанном городе
!ping | !пинг - попинговать бота
```
Но на самом деле я бот больше для общения, чем для исполнения команд.
Поговоришь со мной?
';
} elsif (substr($text, 1) eq "ping") {
$reply = "Pong.";
} elsif (substr($text, 1) eq "пинг") {
$reply = "Понг.";
} elsif (substr($text, 1) eq "pong") {
$reply = "Wat?";
} elsif (substr($text, 1) eq "понг") {
$reply = "Шта?";
} elsif (substr($text, 1, 2) eq 'w ' || substr($text, 1, 2) eq 'п ') {
my $city = substr($text, 3);
$reply = weather($city);
}
} elsif (
($text eq $qname) or
($text eq sprintf("%s", $qtname)) or
($text eq sprintf("@%s_bot", $qname)) or # :(
($text eq sprintf("%s ", $qtname))
) {
$reply = "Чего?";
} else {
# phrase directed to bot
if ((lc($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc($text) =~ /^${qtname}[\,|\:]? (.+)/)){
$phrase = $1;
$reply = $hailo->{$msg->chat->id}->learn_reply($phrase);
# bot mention by name
} elsif ((lc($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc($text) =~ / $qname$/)) {
$phrase = $text;
$reply = $hailo->{$msg->chat->id}->reply($phrase);
# bot mention by telegram name
} elsif ((lc($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc($text) =~ / $qtname$/)) {
$phrase = $text;
$reply = $hailo->{$msg->chat->id}->reply($phrase);
# just message in chat
} else {
$hailo->{$msg->chat->id}->learn($text);
}
}
if (defined($reply) && $reply ne '' && $can_talk) {
# work a bit more on input phrase
$phrase = trim($phrase);
while ($phrase =~ /[\.|\,|\?|\!]$/) {
chop $phrase;
}
$phrase = lc($phrase);
if (lc($reply) eq $phrase) {
$reply = randomCommonPhrase();
} elsif (lc($reply) eq substr($phrase, 0, -1)) {
# in case of trailing dot
$reply = randomCommonPhrase();
} elsif (substr(lc($reply), 0, -1) eq $phrase) {
$reply = randomCommonPhrase();
}
logger ("reply with: $reply");
$msg->reply($reply);
} else {
if ($can_talk) {
logger ("no reply");
} else {
logger ("Can't talk, but reply is: $reply");
}
}
# should be channel, so we can't talk
} else {
return;
}
return;
}
# setup our bot
sub init {
unless (-d $c->{telegrambot}->{braindir}) {
mkpath ($c->{telegrambot}->{braindir}, 0, 0755);
}
my $self = shift;
$self->add_listener(\&__on_msg);
# $self->add_repeating_task(900, \&__cron);
}
sub run_telegrambot {
while (sleep 3) {
eval {
telegrambot->new->think;
}
}
}
# complete framework with our getChat()
sub getChat {
my $self = shift;
my $id = shift;
my $send_args = {};
$send_args->{chat_id} = $id;
my $token = $self->token;
my $url = "https://api.telegram.org/bot${token}/getChat";
my $api_response = $self->_post_request($url, $send_args);
# we seek for permissions, when making call to this subroutine, but
# framework does just omits it, when creating object from hash, so
# pick raw json object instead
#return Telegram::Bot::Object::User->create_from_hash($api_response, $self);
return $api_response;
}
# complete framework with our getChatMember()
sub getChatMember {
my $self = shift;
my $chatid = shift;
my $userid = shift;
my $send_args = {};
$send_args->{chat_id} = $chatid;
$send_args->{user_id} = $userid;
my $token = $self->token;
my $url = "https://api.telegram.org/bot${token}/getChatMember";
my $api_response = $self->_post_request($url, $send_args);
# return Telegram::Bot::Object::User->create_from_hash($api_response, $self);
return $api_response;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4: