From 2f3e3f764e56915ec3cc04f29025f8ff65ae2ad0 Mon Sep 17 00:00:00 2001 From: eleksir Date: Sun, 1 Aug 2021 00:09:02 +0300 Subject: [PATCH] Initial commit --- .gitignore | 16 + .perlcriticrc | 100 +++ LICENSE | 127 ++++ README.md | 41 + bin/aleesa-irc-bot | 89 +++ bin/flickr_init.pl | 29 + bin/fortune_seed.pl | 28 + bin/friday_seed.pl | 27 + bin/train_lat.pl | 26 + bootstrap.sh | 5 + confcheck.pl | 36 + cpanfile | 25 + data/fortune_src/citates | 521 +++++++++++++ data/friday.txt | 106 +++ data/lat.txt | 1336 +++++++++++++++++++++++++++++++++ data/sample_config.json | 61 ++ lib/Bot/IRC.pm | 1455 ++++++++++++++++++++++++++++++++++++ lib/Bot/IRC/OnMessage.pm | 198 +++++ lib/BotLib.pm | 134 ++++ lib/BotLib/Anek.pm | 76 ++ lib/BotLib/Archeologist.pm | 126 ++++ lib/BotLib/Buni.pm | 58 ++ lib/BotLib/Conf.pm | 41 + lib/BotLib/Drink.pm | 124 +++ lib/BotLib/Fisher.pm | 133 ++++ lib/BotLib/Fortune.pm | 85 +++ lib/BotLib/Fox.pm | 54 ++ lib/BotLib/Friday.pm | 96 +++ lib/BotLib/Image.pm | 70 ++ lib/BotLib/Image/Flickr.pm | 639 ++++++++++++++++ lib/BotLib/Karma.pm | 125 ++++ lib/BotLib/Kitty.pm | 53 ++ lib/BotLib/Lat.pm | 73 ++ lib/BotLib/Monkeyuser.pm | 62 ++ lib/BotLib/Util.pm | 116 +++ lib/BotLib/Weather.pm | 176 +++++ lib/BotLib/Xkcd.pm | 42 ++ lib/IRCBot.pm | 58 ++ 38 files changed, 6567 insertions(+) create mode 100644 .gitignore create mode 100644 .perlcriticrc create mode 100644 LICENSE create mode 100644 README.md create mode 100755 bin/aleesa-irc-bot create mode 100644 bin/flickr_init.pl create mode 100644 bin/fortune_seed.pl create mode 100644 bin/friday_seed.pl create mode 100644 bin/train_lat.pl create mode 100644 bootstrap.sh create mode 100755 confcheck.pl create mode 100644 cpanfile create mode 100644 data/fortune_src/citates create mode 100644 data/friday.txt create mode 100644 data/lat.txt create mode 100644 data/sample_config.json create mode 100644 lib/Bot/IRC.pm create mode 100644 lib/Bot/IRC/OnMessage.pm create mode 100644 lib/BotLib.pm create mode 100644 lib/BotLib/Anek.pm create mode 100644 lib/BotLib/Archeologist.pm create mode 100644 lib/BotLib/Buni.pm create mode 100644 lib/BotLib/Conf.pm create mode 100644 lib/BotLib/Drink.pm create mode 100644 lib/BotLib/Fisher.pm create mode 100644 lib/BotLib/Fortune.pm create mode 100644 lib/BotLib/Fox.pm create mode 100644 lib/BotLib/Friday.pm create mode 100644 lib/BotLib/Image.pm create mode 100644 lib/BotLib/Image/Flickr.pm create mode 100644 lib/BotLib/Karma.pm create mode 100644 lib/BotLib/Kitty.pm create mode 100644 lib/BotLib/Lat.pm create mode 100644 lib/BotLib/Monkeyuser.pm create mode 100644 lib/BotLib/Util.pm create mode 100644 lib/BotLib/Weather.pm create mode 100644 lib/BotLib/Xkcd.pm create mode 100644 lib/IRCBot.pm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2a46dc6 --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +vendor_perl/** +data/brains/** +data/config.json +data/*.sqlite +data/cache/** +data/fortune/** +data/friday/** +data/image/** +data/karma/** +data/lat/** +TODO +*.pid +*.log +_Deparsed_XSubs.pm +.idea/** +.vstags \ No newline at end of file diff --git a/.perlcriticrc b/.perlcriticrc new file mode 100644 index 0000000..d7e31fa --- /dev/null +++ b/.perlcriticrc @@ -0,0 +1,100 @@ +#!/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 of course 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 cares, 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 enough 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 + +[-ErrorHandling::RequireCheckingReturnValueOfEval] +# In this app eval is not critical to error, so there is no need to check for it + +[-InputOutput::RequireBriefOpen] +# Yes, i do! + +[-ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions] +# used only in botlib.pm, in this particular case it makes more clean code + +[-ControlStructures::ProhibitDeepNests] +# jabber bot lib have very nested structures that a bit fiddle to navigate :( diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4ff3f42 --- /dev/null +++ b/LICENSE @@ -0,0 +1,127 @@ + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. + +Definitions: + + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + + The End diff --git a/README.md b/README.md new file mode 100644 index 0000000..f243936 --- /dev/null +++ b/README.md @@ -0,0 +1,41 @@ +# Aleesa-IRC-bot - Simple IRC chatty bot + +## About + +It is based on Perl modules [Bot::IRC][1] and [Hailo][2] as +conversation generator. + +Config located in **data/config.json**, sample config provided as +**data/sample_config.json**. + +Bot can be run via **bin/aleesa-irc-bot** and acts as daemon. + +This bot has an experimental status due to lack of thorough testing. + +## Installation + +In order to run this application, you need to "bootstrap" it - download and +install all dependencies and libraries. + +You'll need "Development Tools" or similar group of packages, perl, perl-devel, +perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel, +libdb4-devel (Berkeley DB devel), make. + +After installing required dependencies it is possible to run: + +```bash +bash bootstrap.sh +``` + +and all libraries should be downloaded, built, tested and installed. + +## Caveats + +Due to hard limitations on many IRC servers, I have to implement help message +in different manner comparing to my other bots. The point is IRC does not +support multiline messages. So message must not contain newline or return +carriage symbol. So I have to split help by topics. Say thanks to author of +this bot framework help topics are so easy to implement. + +[1]: https://metacpan.org/pod/Bot::IRC +[2]: https://metacpan.org/pod/Hailo diff --git a/bin/aleesa-irc-bot b/bin/aleesa-irc-bot new file mode 100755 index 0000000..2e502d5 --- /dev/null +++ b/bin/aleesa-irc-bot @@ -0,0 +1,89 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use version; our $VERSION = qw (1.0); + +my $workdir; + +# before we run, change working dir +BEGIN { + use Cwd qw (chdir abs_path); + my @CWD = split /\//, abs_path ($PROGRAM_NAME); + + if ($#CWD > 1) { + $#CWD = $#CWD - 2; + } + + $workdir = join '/', @CWD; + chdir $workdir; +} + +use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); +no Cwd; +use Cwd::utf8 qw (abs_path); +use POSIX qw (setgid setuid); +use File::Path qw (make_path); +use File::Basename qw (dirname); +use BotLib::Conf qw (LoadConf); +use IRCBot qw (RunIRCBot); + +# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined +if ($UID == 0) { + my $C = LoadConf (); + + unless (defined $C->{user}) { + die "Unable to run as root, please define unprivileged user in config.json\n"; + } + + my ($uid, $gid) = (getpwnam $C->{user})[2,3]; + my $piddir = dirname $C->{pid}; + + unless (-d $piddir) { + make_path ( + $piddir, { + uid => $uid, + group => $gid + } + ) or die "Unable to create $piddir: $OS_ERROR\n"; + } + + my $logfile; + + if (defined $C->{'log'}) { + $logfile = $C->{'log'}; + } elsif (defined $C->{'debug_log'}) { + $logfile = $C->{'debug_log'}; + } + + if (defined $logfile) { + my $logdir = dirname $logfile; + + unless (-d $logdir) { + make_path ( + $logdir, { + uid => $uid, + group => $gid + } + ) or die "Unable to create $logdir: $OS_ERROR\n"; + } + } + +# drop privs + setgid ($gid) or die "Unable to switch to group of $C->{user}: $OS_ERROR\n"; + setuid ($uid) or die "Unable to switch to account $C->{user}: $OS_ERROR\n"; +} + +# set correct proctitle +$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars) + +RunIRCBot (); + +exit 0; + +__END__ +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/bin/flickr_init.pl b/bin/flickr_init.pl new file mode 100644 index 0000000..0d58b19 --- /dev/null +++ b/bin/flickr_init.pl @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use version; our $VERSION = qw (1.0); + +my $workdir; + +# before we run, change working dir +BEGIN { + use Cwd qw (chdir abs_path); + my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); + if ($#CWD > 1) { $#CWD = $#CWD - 2; } + $workdir = join '/', @CWD; + chdir $workdir; +} + +use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); +use BotLib::Image::Flickr qw (FlickrInit); + +if (FlickrInit ()) { + exit 0; +} else { + exit 1; +} diff --git a/bin/fortune_seed.pl b/bin/fortune_seed.pl new file mode 100644 index 0000000..43f6006 --- /dev/null +++ b/bin/fortune_seed.pl @@ -0,0 +1,28 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); + +use version; our $VERSION = qw (1.0); + +my $workdir; + +# before we run, change working dir +BEGIN { + use Cwd qw (chdir abs_path); + my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); + if ($#CWD > 1) { $#CWD = $#CWD - 2; } + $workdir = join '/', @CWD; + chdir $workdir; +} + +use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); +use BotLib::Fortune qw (Seed); + +Seed (); + +exit 0; diff --git a/bin/friday_seed.pl b/bin/friday_seed.pl new file mode 100644 index 0000000..20f55d7 --- /dev/null +++ b/bin/friday_seed.pl @@ -0,0 +1,27 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use version; our $VERSION = qw (1.0); + +my $workdir; + +# before we run, change working dir +BEGIN { + use Cwd qw(chdir abs_path); + my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); + if ($#CWD > 1) { $#CWD = $#CWD - 2; } + $workdir = join '/', @CWD; + chdir $workdir; +} + +use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); +use BotLib::Friday qw (Seed); + +Seed (); + +exit 0; diff --git a/bin/train_lat.pl b/bin/train_lat.pl new file mode 100644 index 0000000..82dec2b --- /dev/null +++ b/bin/train_lat.pl @@ -0,0 +1,26 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use version; our $VERSION = qw (1.0); + +my $workdir; + +# before we run, change working dir +BEGIN { + use Cwd qw(chdir abs_path); + my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); + if ($#CWD > 1) { $#CWD = $#CWD - 2; } + $workdir = join '/', @CWD; + chdir $workdir; +} + +use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); +use BotLib::Lat qw (Train); + +Train (); +exit 0; diff --git a/bootstrap.sh b/bootstrap.sh new file mode 100644 index 0000000..697f373 --- /dev/null +++ b/bootstrap.sh @@ -0,0 +1,5 @@ +#!/bin/bash + +cpanm -l vendor_perl --self-contained --force --update --installdeps . + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/confcheck.pl b/confcheck.pl new file mode 100755 index 0000000..0b18981 --- /dev/null +++ b/confcheck.pl @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use lib qw (./lib ./vendor_perl ./vendor_perl/lib/perl5); +use JSON::PP; + +use version; our $VERSION = qw (1.0); + +my $c = 'data/config.json'; +open (my $C, '<', $c) || die "No conf at $c: $OS_ERROR\n"; +my $len = (stat $c) [7]; +my $json; +my $readlen = read ($C, $json, $len); + +unless ($readlen) { + close C; ## no critic (InputOutput::RequireCheckedSyscalls) + die "Unable to read $c: $OS_ERROR\n"; +} + +if ($readlen != $len) { + close C; ## no critic (InputOutput::RequireCheckedSyscalls) + die "File $c is $len bytes on disk, but we read only $readlen bytes\n"; +} + +close C; ## no critic (InputOutput::RequireCheckedSyscalls) +$c = decode_json ($json); + +my $j = JSON::PP->new->pretty->canonical->indent_length (4); ## no critic (ValuesAndExpressions::ProhibitLongChainsOfMethodCalls) +print $j->encode ($c); ## no critic (InputOutput::RequireCheckedSyscalls) + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..115d02a --- /dev/null +++ b/cpanfile @@ -0,0 +1,25 @@ +requires "Bot::IRC"; +requires "CHI"; +requires "CHI::Driver::BerkeleyDB"; +requires "Cwd"; +requires "Cwd::utf8"; +requires "DateTime"; +requires "DB_File"; +requires "Digest::HMAC_SHA1"; +requires "Digest::SHA"; +requires "Encode"; +requires "English"; +requires "File::Basename"; +requires "File::Path"; +requires "Hailo"; +requires "HTML::TokeParser"; +requires "HTTP::Tiny"; +requires "JSON::XS"; +requires "JSON::PP"; +requires "Math::Random::Secure"; +requires "MIME::Base64"; +requires "POSIX"; +requires "SQLite_File"; +requires "Text::Fuzzy"; +requires "URI::Encode::XS"; +requires "URI::URL"; diff --git a/data/fortune_src/citates b/data/fortune_src/citates new file mode 100644 index 0000000..b019f4c --- /dev/null +++ b/data/fortune_src/citates @@ -0,0 +1,521 @@ +Что сказал Берлиоз своей музыкой? - ничего; но как потрясающе он это +сказал. + -- Джеймс Гиббонз Хьюнекер +% +Музыка будет по-немецки, вы не поймете. + -- Оскар Уайльд +% +Четвертый раз смотрю этот фильм и должна вам сказать, что сегодня актеры +играли как никогда. + -- Фаина Раневская +% +Продолжительность фильма определяется выносливостью мочевого пузыря +обычного зрителя. + -- Альфред Хичкок +% +А что, если наша Земля - ад какой-нибудь другой планеты? + -- Олдос Хаксли +% +Если видишь женщину голой достаточно долго, опять начинаешь обращать +внимание на ее лицо. + -- Генри Миллер +% +Самое главное - выглядеть совершенно естественно; но для этого нужно очень +много косметики. + -- Кельвин Кляйн +% +Любовь - лучшая косметика. Но косметику купить легче. + -- Ив Сен-Лоран +% +Людей без лишнего веса больше всего на кладбище. + -- Биверли Силлз +% +Лучше быть молодым навозным жуков, чем старой райской птицей. + -- Марк Твен +% +К старости недостатки ума становятся все заметнее, как и недостатки +внешности. + -- Франсуа Ларошфуко +% +Лучше быть старой, чем мертвой. + -- Бриджит Бардо +% +Вечеринка с коктейлями: место, где можно встретить людей, которые пьют так +много, что вы не можете вспомнить их имена. + -- Космо Сардо +% +Средство от похмелья: выжать сок из двух бутылок виски... + -- Эдди Кондон +% +Дважды два уже четыре, а будет еще лучше. + -- Хенрик Ягодзинский +% +Я сидел на диете 14 дней и потерял всего две недели. + -- Тоти Филдс +% +В жизни можно полагаться только на себя самого. Да и то не советую! + -- Тристан Бернар +% +Источник нашей мудрости - наш опыт. Источник нашего опыта - наша глупость. + -- Саша Гитри +% +Уходя на тот свет, не забудь выключить этот. + -- Виктор Коваль +% +Я не верю ни единому слову из того, что вы говорите... или я вам. + -- Оскар Уайльд +% +Я думаю, мы должны говорить правду или хотя бы говорить то, что мы думаем. + -- Юрий Лужков +% +Нельзя иметь все. Куда вы это положите? + -- Стивен Райт +% +Сначала забываешь имена, потом забываешь лица, потом забываешь застегивать +ширинку, потом забываешь расстегивать ширинку. + -- Лео Розенберг +% +Время - лучший учитель, но, к сожалению, оно убивает своих учеников. + -- Гектор Берлиоз +% +Прошлое - чужая страна, там все по-другому. + -- Лесли Хартли +% +Помните о бедняках - это не требует никаких расходов. + -- Генри Уиллер Шоу +% +Я люблю своих детей, но некоторые мне не нравятся. + -- Лилиан Картер, мать президента США Д.Картера +% +Дружба - это когда можно ни с того ни с сего приехать к человеку +и поселиться у него. + -- Давид Самойлов +% +Врагов я забрасываю цветами - в гробу! + -- Сальвадор Дали +% +Я не боюсь умереть. Я просто не хочу при этом присутствовать. + -- Вуди Аллен +% +Какой замечательный некролог! С таким бы жить и жить! + -- М.Генин +% +Твои шансы выиграть в лотерею возрастут, если ты купишь билет. + -- Уинстон Грум из "Правил Фореста Гампа" +% +Пока вы ищете, кого бы стоило полюбить, вам нужен кто-то, кто любит вас. + -- Шейла Делейни +% +Если двое любят друг друга, это не может счастливо кончиться. + -- Э.Хемингуэй +% +Я порвала с ним через три года. Это была типичная любовь-ненависть. Мы оба +любили его и ненавидели меня. + -- Кэрол Зискинд +% +В тех кругах, в которых я вращаюсь, переспать с женщиной - недостаточный +повод для того, чтобы быть ей представленным. + -- Вирджиния Маклауд +% +Она говорила на восемнадцати языках и ни на одном из них не умела сказать +"нет". + -- Дороти Паркер +% +Помни: в пяти случаях из шести свет в конце туннеля - это свет +надвигающегося поезда. + -- Пол Диксон +% +Все соседи плохи, но верхние хуже нижних. + -- Константин Мелихан +% +Америка - единственный матриархат, под сенью которого женщины ведут борьбу +за равные права. + -- А. Рот +% +Брак - это лотерея, но в случае проигрыша вы не можете порвать свой билет. + -- Ф. Ноулз +% +Британский солдат устоит против кого угодно, только не против Британского +министерства обороны. + -- Бернард Шоу +% +Век наш таков, что он гордится машинами, умеющими думать, и побаивается +людей, которые пытаются проявить ту же способность. + -- Г.Мамфорд Джонс +% +Военная мудрость есть понятие, заключающее противоречие в самом себе. +Война - слишком серьезное дело, чтобы доверять его военным. + -- Талейран +% +Выход из беды найти не столь просто, как попасть в нее. + -- Эд Хау +% +Граница в политической географии - воображаемая линия между двумя +государствами, отделяющая воображаемые права одного от воображаемых прав +другого. + -- А.Бирс +% +Да не устрашит тебя величие: одни рождаются великими, другие достигают +величия, третьим его навязывают. + -- Уильям Шекспир +% +Две тысячи лет нам поставляли примеры для подражания, и теперь ничто нас +не извиняет, если мы, воюя, воем плохо. + -- Т.Э. Лоуренс +% +Дипломная работа среднего выпускника университета есть не что иное, как +кости, перенесенные из одной могилы в другую. + -- Дж. Фрэнк Доуби +% +Для любой волнующей человека проблемы всегда легко найти решение - +простое, достижимое и ошибочное. + -- Г.Л. Менкен +% +Добрым словом и револьвером вы можете добиться гораздо большего, чем одним +только добрым словом. + -- Аль Капоне +% +Если вы не восходящий, значит, вы ниспадающий. + -- Стивен Поттер +% +Если честолюбивая мечта не заставляет вас страдать, значит, ее у вас нет. + -- К. Норрис +% +Идеалист тот, кто, заметив, что роза пахнет лучше капусты, заключает, что +и суп из нее будет лучше. + -- Г. Менкен +% +Жизнь что луковица - вы чистите ее, снимая слой за слоем, и иногда +плачете. + -- С. Сандберг +% +Когда люди вольны поступать как угодно, они обычно подражают друг другу. + -- Э. Хоффер +% +Коли все думают одинаково, значит, никто особенно и не думает. + -- У.Липпман +% +Компьютеры бесподобны: за несколько минут они могут совершить такую +грандиозную ошибку, какую не в состоянии сделать множество людей за многие +месяцы. + -- М. Мичэм +% +Логика - это искусство ошибаться с уверенностью в своей правоте. + -- Дж. У. Крач +% +Любовь - вещь идеальная, супружество - реальная; смешение реального с +идеальным никогда не проходит безнаказанно. + -- И. Гете +% +Любое ваше решение - это ошибка. + -- Эдуард Далберг +% +Мой способ шутить - это говорить правду. На свете нет ничего +смешнее. + -- Бернард Шоу +% +На моем веку было очень много прогресса, но, боюсь, не в том направлении. + -- О. Нэш +% +Нам мало добиться успеха. Надо еще, чтобы друзья наши потерпели крах. + -- Ларошфуко +% +Невеста - женщина, у которой виды на счастье остались позади. + -- А. Бирс +% +Нужно учредить Нобелевскую премию за остроумие. Без физиков, химиков, +экономистов мы, если прижмет, как-нибудь обойдемся. Без мира обычно тоже +обходимся. Без остроумия - пропадем. + -- Джордж Ф. Уилл +% +О несчастном случае мой подзащитный впервые узнал лишь тогда, когда этот +случай произошел. + -- Из речи адвоката +% +Первый и наихудший из всех подвохов - обмануть самого себя. Потом уже +легко впасть в любой грех. + -- Дж. Бэйли +% +По самой своей природе человек, чем старше он становится, тем больше +противится переменам, особенно переменам к лучшему. + -- Дж. Стейнбек +% +Поиск истины способен изрядно позабавить. + -- Вернон Говард +% +Полицейский находится на своем месте не для того, чтобы создавать +беспорядок; полицейский находится там, чтобы поддерживать беспорядок. + -- Ричард Дж. Дейли, мэр Чикаго +% +Посредственность - добродетель в глазах посредственных людей. + -- Ж. Жобер +% +Посредственный учитель излагает. Хороший учитель объясняет. Выдающийся +учитель показывает. Великий учитель вдохновляет. + -- Уильям Артур Уорд +% +Президенту в его окружении не нужны мужчины и женщины, умеющие только +поддакивать. Если он говорит "нет", мы все говорим "нет". + -- Элизабет Доул, помощница президента Рейгана +% +"Радость моя, мы живем в переходную эпоху", говорил Адам Еве по дороге из +рая. + -- У. Инге +% +"С нами такого случиться не может" - это фраза номер один в списке +знаменитых последних слов. + -- Дэвид Кросби +% +Самая большая ложь - это неверно понятая правда. + -- Уильям Джеймс +% +Скрипка - инструмент для щекотания человеческих ушей при помощи трения +лошадиного хвоста о внутренности кошки. + -- Амброз Бирс +% +Среди преподавателей большинство составляют те, кто не прервет чтение +своих лекций по навигации, даже если корабль уже тонет. Следствие: +путешествие длиною в тысячу миль завершается одним-единственным шагом. + -- Джеймс Г. Борен +% +Творческое мышление, возможно, означает всего-навсего понимание, что нет +никакой особой добродетели в том, чтобы вести дела так, как их всегда вели до +нас. + -- Рудольф Флеш +% +Технический прогресс лишь снабдил нас действенными средствами для движения +назад. + -- О. Хаксли +% +То, что мы называем прогрессом, представляет собой замену одной +неприятности другою. + -- Г. Эллис +% +Учитель прикасается к вечности: никто не может сказать, где кончается его +влияние. + -- Генри Адамс +% +Человеку надлежит жить с самим собой и постоянно заботиться, чтобы это +была хорошая кампания. + -- С.И. Хьюз +% +Эксперт - это человек, знающий все больше и больше о все меньшем и +меньшем. Следствие: колледж не может обеспечить компетентность; он может +обеспечить диплом. + -- Николас Батлер +% +Эксперт - это человек, который больше уже не думает; он знает. + -- К. Хаббард +% +Я не верю в коллективную мудрость невежественных индивидуумов. + -- Т. Карлейль +% +Я не против полиции, я просто боюсь ее. + -- Альфред Хичкок +% +Я никогда не мог взять в толк, почему из-за того только, что я выражаюсь +невразумительно, никто меня не понимает. + -- Милтон Мейер +% +Пожилые люди думают, что с тех пор, как они постарели, мир только теряет, +но ничего не приобретает. + -- Жеремена Сталь +% +Меня интересует мнение не тех людей, которые разбираются в данном вопросе, +а тех, которые сами кое-что сделали в одной из областей знания. + -- Hорберт Винер +% +Случайные открытия совершают только подготовленные умы. + -- Паскаль +% +Бывают услуги настолько большие, что рассчитаться за них можно только +неблагодарностью. + -- Дюма-отец +% +"Тоже неплохо!" - сказал зять, бросив камнем в собаку, а попав в тещу. + -- Плутарх. "Пир семи мудрецов". +% +Не ковыряй в носу перочинным ножиком. Лезвие легко ржавеет. + -- Из книги "Пи" +% +Очень много - иногда вполне достаточно для женщины. + -- Из книги "Ву" +% +В жизни можно рассчитывать только на самих себя. И то не всегда. + -- Тристан Бернар +% +Все было бы очень хорошо, если бы все наши поступки можно было бы совершать +дважды. + -- Гете +% +E = mC + -- Альберт Эйнштейн +% +Человек бывает таким, каким его создал бог, но преимущественно немного хуже. + -- Сервантес +% +Две параллельных линии полюбили друг друга. Трагедия! + -- Из книги "Пи" +% +Я знаток всех "и т. д., и т. п." и я знаю, когда за ними ничего больше +не скрывается. + -- Гомес де ля Серна +% +Одна туча может погрузить в темноту весь парк, одно слово может затемнить +самое большое счастье. + -- Гомес де ля Серна +% +Тот факт, что будильник не прозвенел, изменило уже много человеческих судеб. + -- Агата Кристи +% +Заполнять жизнь - это еще не значит обогащать ее. + -- Из книги "Пи" +% +Самым серьезным достоинством современного искусства является то, что, когда +эти произведения смотрят дети, они не задают таких вопросов, на которые +обычно бывает трудно отвечать. + -- Лорд Галлюкс +% +Замужних женщин значительно больше, чем женатых мужчин. + -- По данным американской статистики +% +Совесть - это тот голос, который говорит тебе, что не надо делать именно то, +что ты только что сделал. + -- Из книги "Пи" +% +И мелкие неприятности могут отравить жизнь, если нет крупных. + -- Р. Гомес де ля Серна +% +Счастлив тот, кто ни о чем не думает. + -- Софокл +% +Я не читаю газет. Все, о чем там стоит знать, всегда кто-нибудь расскажет. + -- Лорд Галлюкс +% +Недостаточно встать рано, надо еще и проснуться. + -- Из книги "Ву" +% +Высохшую реку не благодарят за ее прошлое. + -- Рабиндранат Тагор +% +Давать советы всегда плохо, но хорошего совета тебе никто не простит. + -- Оскар Уайльд +% +Устарели не только ответы, но даже сами вопросы. + -- Хемингуэй +% +Друзья, как арбузы: случается, что из десяти ни одного хорошего не выбрать. + -- Из книги "Пи" +% +Пока слушатели во время лекции поглядывают на часы, все в порядке. Страшно, +когда они начинают удивленно подносить часы к уху. + -- Из книги "Пи" +% +Нет правила, которого нельзя было бы нарушить ради более прекрасного. + -- Л. Бетховен +% +Прекрасна молодость, когда она в движении и знает, куда приложить свои силы. + -- Менандр +% +Простим горячке юных лет +И юный жар, и юный бред. + -- А. С. Пушкин +% +Грустно думать, что напрасно +Была нам молодость дана. + -- А. С. Пушкин +% +Всего больнее знать, что счастье было так близко - и ты сам его отверг. + -- Софокл +% +Настоящий художник настолько владеет искусством, насколько оно владеет им. + -- Г. Флобер +% +Великие люди сами сооружают себе пьедестал; статую воздвигнет будущее. + -- В. Гюго +% +...заслуги отца на сына не распространяются. + -- М. Сервантес +% +Давайте жить так, чтобы даже гробовщику стало жалко, когда мы умрем. + -- Марк Твен +% + - Обладаешь ли ты разумом? + - Обладаю. + - Почему же ты не пользуешься им? + -- Марк Авелий +% +Нет такой глупости, которой нельзя было бы исправить при помощи ума, +и нет такой мудрости, которой нельзя было бы испортить при помощи глупости. + -- В. Гёте +% +Оптимист верит, что мы живем в лучшем из миров. +Пессимист боится, что так оно и есть. +% +Пессимист видит темный туннель. +Оптимист видит свет в конце туннеля. +Реалист видит, что это на них мчится поезд. +И только машинист видит трех мудаков, тупящих на рельсах. +% +Мы познаем человека не по тому, что он знает, а по тому, чему он радуется. + -- Р.Тагор +% +Если вы уверены в победе вашей национальной сборной на Евро 2004, то вы либо +дурак, либо немец. + -- М.Задорнов +% +Нет некрасивых женщин - есть только женщины, не знающие, что они красивы. + -- Вивьен Ли +% +Любая сложная технология неотличима от волшебства. + -- Артур Кларк +% +Я люблю тебя не за то, кто ты, а за то, кто я, когда я с тобой. + -- Габриэль Гарсиа +% +Ни один человек не заслуживает твоих слез, а те, кто заслуживают, +не заставят тебя плакать. + -- Габриэль Гарсиа +% +Только потому что кто-то не любит тебя так, как тебе хочется, не значит, +что он не любит тебя всей душой. + -- Габриэль Гарсиа +% +Настоящий друг – это тот, кто будет держать тебя за руку +и чувствовать твоё сердце. + -- Габриэль Гарсиа +% +Худший способ скучать по человеку – это быть с ним и понимать, +что он никогда не будет твоим. + -- Габриэль Гарсиа +% +Никогда не переставай улыбаться, даже когда тебе грустно: кто-то может влюбиться +в твою улыбку. + -- Габриэль Гарсиа +% +Возможно, в этом мире ты всего лишь человек, но для кого-то ты – весь мир. + -- Габриэль Гарсиа +% +Не трать время на человека, который не стремится провести его с тобой. + -- Габриэль Гарсиа +% +Возможно, Бог хочет, чтобы мы встречали не тех людей до того, как встретим того +единственного человека. Чтобы, когда это случится, мы были благодарны. + -- Габриэль Гарсиа +% +Не плачь, потому что это закончилось. Улыбнись, потому что это было. + -- Габриэль Гарсиа +% +Всегда найдутся люди, которые причинят тебе боль. Нужно продолжать верить людям, +просто быть чуть осторожнее. + -- Габриэль Гарсиа +% +Стань лучше и сам пойми, кто ты, прежде чем встретишь нового человека и будешь +надеяться, что он тебя поймет. + -- Габриэль Гарсиа +% +Не прилагай столько усилий, все самое лучшее случается неожиданно. + -- Габриэль Гарсиа +% +Всё, что случаеется, имеет причину. + -- Габриэль Гарсиа diff --git a/data/friday.txt b/data/friday.txt new file mode 100644 index 0000000..63db2c0 --- /dev/null +++ b/data/friday.txt @@ -0,0 +1,106 @@ +А пятница-то не настоящая!!! || 34 +Спасибо, кэп! || 5 +А за пивом сегодня идет user || 5 +user, ты пиво купил? || 5 +Пятница хоть и небольшой праздник, НО ЗАТО ПОСТОЯННЫЙ! || 45 +Мечта о пятнице — самая распространенная среди работающего населения. Она начинается уже в понедельник и продолжается четыре дня в неделю || 123 +Господи дай мне сил не напиться! А если напьюсь, то сделай так чтобы я не плясала, если сил твоих не хватит и я все-таки запляшу, постарайся хотя бы сделать так, что бы не пела! А если и это не удастся, сломай к чертям сервер Ю-тюба! || 5 +К пятнице готова! Мобильный заряжен, баланс пополнен, в кармане записка с моим адресом || 5 +ПРЕДУПРЕЖДЕНИЕ: Чрезмерное употребление… Алкоголя. делает ВАШУ пятницу… ОФИГИТЕЛЬНОЙ || 5 +Сломай систему! Порви шаблоны! Начни новую жизнь с пятницы! || 5 +В пятницу совесть доживает только до обеда… || 5 +Сколько работнику не плати, всё равно пятницы ждёт || 1234 +Робинзооон!!! || 5 +В пятницу чаще всего хочется выпить. В понедельник чаще всего хочется пятницу. || 15 +Здравствуй Пятница, здравствуй, любимая, наконец-то ты пришла! || 5 +Зарплата в пятницу — удар по печени. || 5 +Вот и пятница пришла, счастье, радость принесла! || 5 +Все мы — пятницофилы и понедельникофобы. || 15 +Люблю понедельник — всего три дня до пятницы. || 1 +Ну здравствуй, пятница. Я дополз к тебе. || 5 +Пятница. Улыбните Улыбальник. || 5 +Чувствуете? Выходными пахнет! || 5 +До пятницы осталось…. пережить четверг! || 4 +Если пятый день подряд опаздываешь на работу, значит сегодня пятница. || 5 +От понедельника до пятницы очень далеко, а от пятницы до понедельника рукой подать. || 123467 +Жизнь начинается в пятницу вечером… В остальное время — выживание. || 5 +Пятница… белочки следят за тобой. || 5 +Примета: Если утром жена с вами не разговаривает, значит, вчера была пятница. || 6 +Чем ближе пятница, тем добрее утро! || 1234 +Пятница — лучший день недели, особенно её вечер, так как выходные еще не начались, а работа уже закончилась. || 5 +Отличной была пятница! Особенно запомнились русские народные катания на полицейских бобиках! || 1 +Четверг это маленькая пятница, а пятницу можно считать выходным. || 4 +Пятница традиционно начиналась легким ужином в четверг и заканчивалась плотным завтраком в понедельник. || 4 +Уже с пятницы начинаешь бояться, что скоро понедельник! || 67 +Каждую пятницу жизнь начинается сначала. || 5 +С пятницами надо быть осторожней. Они обещают слишком уж многое. Они словно рецензия на кинофильм: лишь в редких случаях предсказанное ими сбывается. || 5 +Русские в понедельник не работают — у них тяжелый день. || 1 +Все мы просто дети, изображающие на работе профессионалов, а на самом деле ждущие пятницы, чтобы быть сами собой! || 5 +Почему-то в пятницу хочется ничего не делать. Хотя в другие дни тоже хочется, но в пятницу ничего не делать хочется особенно сильно. || 5 +Хочешь жить завтрашним днем — устрой себе семь пятниц на неделе. || 5 +Что мне снег, что мне зной, что мне вермут разливной, когда мои друзья со мной! || 5 +Каждую пятницу количество довольных жизнью людей увеличивается на пару миллиардов. Этот эффект длится вплоть до понедельника. || 123467 +Так, Понедельник, Вторник, Среда, Четверг, проходим, проходим, не задерживаем Пятницу! || 1234 +Четверг. Смотрю на часы — 16.00. Еле сдерживаюсь, чтобы не закричать — Ура! Во Владивостоке Пятница! || 4 +Пятница — друг человека! || 5 +В пятницу вечером понимаешь, что в принципе — жить можно. || 5 +Ничто так не портит пятницу, как новость о том, что сегодня четверг. || 4 +Жить нужно так, как будто каждый день пятница. || 123467 +Только настроился на работу ― и вдруг снова пятница, снова отдых… Вот так всегда! || 5 +Хорошо, что пятница! Плохо, что еще только утро… || 5 +Уходя вечером с работы, он был рад, что сегодня пятница и можно спрятаться в уикенде. Он накроется субботой и воскресеньем как двумя толстыми одеялами. Ему ничего не хотелось делать; у него даже не хватало мужества читать. || 5 +Понедельник ― отходим от выходных, вторник ― готовимся к работе, среда ― работаем, четверг ― отдыхаем от работы, пятница ― готовимся к выходным. Вывод: может, хватит уже работать по средам! || 3 +Неделя тянется со скоростью улитки. Но в пятницу вечером улитка превращается в Феррари. || 5 +Прогноз погоды на пятницу: облачно, вечером осадки в виде алкоголя, возможен секс. || 5 +А пятница всё ближе. Печень в ужасе, попа в предвкушении! || 5 +Люди, с кем я вчера пила? Объясните, откуда у меня кот и почему люди в магазине мне хлопают… Кстати… никому кот не нужен? || 6 +ПЯТНИЦА — это старинный народный праздник, который начинают праздновать в ПЯТНИЦУ, а заканчивают — в ПОНЕДЕЛЬНИК || 567 +Вчера была пятница, завтра суббота, а сегодня тогда что? || 1 +Сегодня… ПЯТНИЧКА !!! Из хороших новостей пока… ВСЁ… Всем ДОБРА!!! || 5 +Надену-ка я сегодня красное платье… Под цвет глаз… || 5 +Вчера был yesterday || 235 +Вчера была yesterday || 467 +Вчера было yesterday || 1 +Никогда еще ожидание пятницы не было столь актуальным… || 4 +Завтра будет tomorrow || 1234567 +Четверг - это "завтра пятница". И помнить об этом надо в среду || 34 +Понедельник - это не начало новой недели, это задница предыдущей( || 1 +Я, признаться, очень завидую Робинзону Крузо. Живет на острове, никто мозги не е@ет и ПЯТНИЦА, ПЯТНИЦА, ПЯТНИЦА!!! Каждый день ПЯТНИЦА!!! || 1234 +Наступила пятница — значит мечты начинают сбываться || 5 +Вечером в пятницу девчонки должны быть алкоголенькими… || 5 +Позвони мне в субботу рано утром, часов в пятнадцать || 5 +Ну, вот и пятница пришла… Граждане и гражданки! Следите за своей белкой, чтобы она не разгорячилась! || 5 +Ага, вчера был понедельник, а сегодня сразу ПЯТНИЦА! ЩАС! || 2 +Вот пятница пролетела, наступил понедельник, но не все, не все вернулись на свои рабочие места || 1 +Работа не волк… В лес не убежит?.. А вдруг убежит… Так, за раздумьями и мечтами, и проходит рабочий день… || 12345 +Какой бы долгой и увлекательной ни была вечеринка, сделайте все, чтобы завтра проснуться в собственной спальне || 5 +Тяжелое воскресное засыпание объясняется вполне объективной причиной — организм на подсознательном уровне пытается продлить выходной… || 7 +Воскресенье — день недели с привкусом разочарования. Вроде и выходной, но все равно что-то не то || 7 +У воскресного дня есть только один существенный недостаток — он почему-то кончается в два раза быстрее, чем любой понедельник или четверг. || 7 +Первое правило хороших выходных - не вставать рано с постели || 67 +Понедельник — это такой день, когда вместо бейджика хочется повесить табличку: "Осторожно, злая собака" || 1 +Нас тупило утро понедельника || 1 +Бедный понедельник. Его ж никто не любит! || 1 +Вот выйду на пенсию — буду каждый понедельник выходить на улицу в семь утра и смотреть, как люди идут на работу и страдают || 1 +Если бы понедельник имел лицо… я бы его… ударила... || 1 +Завтра во всех домах страны: психологическая драма "утро понедельника" || 7 +Надеюсь, когда-нибудь я проснусь утром, включу новости и услышу: "Понедельник отменен, продолжайте спать…" || 1 +Хороший день словом Моndау не назовут! || 1 +Люди, почему вы злитесь только на понедельник? Как будто в другие дни работать хочется || 1 +Лучше утро пятницы, чем вечер понедельника || 15 +Если вы проживете 70 лет, то проживете 10 лет понедельников… || 1 +Берите пример с понедельника: его никто не ждёт, а ему по)(уй, он все равно приходит… || 1 +Завтра будет лучше, чем вчера! А, нет, завтра ПОНЕДЕЛЬНИК || 7 +Три ужасные новости: 1. Сегодня не пятница. 2. И даже завтра не пятница. 3. И даже послезавтра не пятница || 12 +В понедельник утром, очень сильно завидуешь… безработным || 1 +Понедельник — удобный повод чего-нибудь понеделать... || 1 +Дамы и господа! Предлагаю почтить утро понедельника минутой ворчания || 1 +Вот и начались трудо выебудни || 5 +Каждый понедельник меня мучает вопрос: выходные, вы вообще были? || 1 +На улице вторник, а на душе — вечер пятницы… || 2 +Наступил долгожданный вторник — послезавтра предпоследний день рабочей недели… || 2 +Если второй день не охота идти на работу, значит сегодня вторник || 2 +Предлагаю переименовать четверг в "завтра пятница"! || 4 +Говорят, при Сталине все субботы были рабочие, должно быть он и вправду был садист и тиран! || 6 +Остановись, воскресенье! Ты прекрасно!!! || 7 +Воскресенье — день трагичный. Суббота маячит далеко позади, а до понедельника уже рукой подать || 7 diff --git a/data/lat.txt b/data/lat.txt new file mode 100644 index 0000000..e1862c4 --- /dev/null +++ b/data/lat.txt @@ -0,0 +1,1336 @@ +A caelo usque ad centrum +A capillo usque ad ungues +A capite ad calcem +A casu ad casum +A contrario +A dato +A fortiori +A limine +A majore ad minus +A maximis ad minima +A mensa et toro +A nativitate +A nescire ad non esse +A novo +A parte +A pedibus usque ad caput +A posse ad esse +A posse ad esse non valet consequential +A posteriori +A potentia ad actum +A potiori +A potiori fit denominatio +A prima facie +A priori +A probis probari, ab improbis improbari aequa laus est +A realibus ad realiora +A sacris +A tuo lare incipe +Ab absurdo +Ab aeterno +Ab antiquo +Ab equis ad asinos +Ab esse ad posse valet consequentia +Ab exterioribus ad interiora +Ab extra +Ab hinc +Ab hoc et ab hac +Ab hodierno +Ab hoedis scindere oves +Ab igne ignem +Ab imis unguibus ad verticem summum +Ab imo pectore +Ab inconvenienti +Ab incunabulis +Ab initio +Ab initio nullum, semper nullum +Ab intestato +Ab irato +Ab Jove principium +Ab origine +Ab ovo +Ab ovo usque ad mala +Ab posse ad esse consequentia (illatio) non valet +Ab uno disce omnes +Ab Urbe condita +Abeunt studia in mores +Abiens, abi! +Absente aegroto +Absit omen! +Absit verbo invidia +Absolutio ab instantia +Absolvo te! +Absque nota +Absque omni exceptionae +Abstractum pro concreto +Absurdum in adjecto +Abusus non tollit usum +Abyssus abyssum invocat +Accessio cedit principali +Acta diurna +Acta est fabula! +Actio immanens +Actio in distans +Actio in factum +Actio popularis +Actio transiens +Actore non probante reus absolvitur +Actor sequitur forum rei +Actum atque tractatum +Actum est ilicet! +Actum ut supra +Actus purus +Ad absurdum +Ad acta +Ad aeternum +Ad aras +Ad arbitrium +Ad augusta per angusta +Ad bestias! +Ad Calendas Graecas +Ad captandum benevolentiam +Ad captandum vulgus +Ad cogitandum et agendum homo natus est +Ad delectandum +Ad discendum, non ad docendum +Ad disputandum +Ad ea debeat adaptari jus, quae frequenter eveniunt +Ad exemplum +Ad extra +Ad extremitates +Ad finem +Ad fontes +Ad futuram memoriam +Ad futuram rei memoriam +Ad gloriam +Ad gustum +Ad hastam +Ad Herculis columnas +Ad hoc +Ad hominem +Ad honores +Ad hoste maligno libera nos, Domine +Ad impossibilia nemo tenetur +Ad infinitum +Ad informandum +Ad instar +Ad instruendum +Ad interim +Ad latus +Ad libita librarii +Ad libitum +Ad limina (apostolorum) +Ad litem +Ad litteram +Ad loca! +Ad majorem Dei gloriam +Ad manum +Ad maximum +Ad meliora tempora +Ad meliorem +Ad memorandum +Ad minimum +Ad modum +Ad multos annos +Ad narrandum, non ad probandum +Ad nauseam +Ad normam +Ad notam +Ad notanda +Ad notata +Ad oculos +Ad opus! +Ad patres +Ad patres conscriptos +Ad perpetuam rei memoriam +Ad personam +Ad pias causas +Ad pluralitatem votorum +Ad populum +Ad profundum +Ad publicandum +Ad ratificandum +Ad referendum +Ad rem +Ad se ipsum +Ad totalem evaporabionem +Ad tertium +Ad unguem +Ad unum omnes +Ad usum delphini +Ad usum externum +Ad usum internum +Ad usum populi +Ad usum proprium +Ad usum vitae +Ad valorem +Ad verbum +Ad verbum audiendum +Ad victoriam +Ad vitam +Ad vitam aeternam +Ad vitam aut culpam +Ad vocem +Adhuc sub judice lis est +Adverbium +Advitalitum +Advocatus Dei +Advocatus Diaboli +Aequam memento rebus in arduis servare mentem +Aequat causa effectum +Aequilibrium indifferentiae +Aequo animo +Aequo pulsat pede +Aequum est neminem cum alterius detrimento et injuria fieri locupletiorem +Aere perennius +Aes triplex +Aeterna historia +Aeterna urbs +Aeternae veritates +Aeternum vale +Age, libertate decembri utere +Age, quod agis, et respice finem +Agere sequitur esse +Ager publicus +Agnosco veteris vestigia flammae +Agnus Dei +Ajo! +Albo lapillo notare diem +Alea iacta (jacta) est +Alia editio +Alia tempora +Alibi +Aliena vitia in oculis habemus, a tergo nostra sunt +Alienatio mentis +Alieni juris +Aliis inserviendo consumor +Aliquando bonus dormitat Homerus +Aliud stans, aliud sedens +Alius alio plura invenire potest, nemo omnia +Alma Mater +Alter ego +Alter idem +Altera pars +Altum silentium +Amabile opus +Amabilis insania +Amabilis scientia +Amant alterna Camenae +Amantes sunt amentes +Amantium irae +Amantium irae amoris integratio +Amat victoria curam +Amata nobis quantum amabitur nulla +Amen! +Amicalia desideria +Amici, diem perdidi +Amicus certus in re incerta cernitur +Amicus cognoscitur amore, more, ore, re +Amicus (Animal) humani generis +Amicus incommodus ab inimico non differt +Amicus meus +Amicus Plato, sed magis amica est veritas +Amicus verus +Amor caecus +Amor fati +Amor patriae +Amor vincit omnia +Amor non est medicabilis herbis +An nescis longas regibus esse manus? +An nescis, mi fili, quantilla prudentia mundus regatur? +Analogia entis +Anathema maranata +Ancilla philosophiae +Ancilla theologiae +Anguis in herba +Angulus ridet +Anima +Anima vilis +Animalia vivunt, crescunt et sentiunt +Animam in promptu habere +Animi magnitudo +Animus +Animus denuntiandi +Animus injuriandi +Animus meminisse horret +Animus possidendi +Animus quod perdidit optat, Atque in praeterita se totus imagine versat +Animus rem sibi habendi +Animus suspicax +Anni currentis +Anno +Anno ab urbe condita +Anno aetatis suae +Anno ante Christum Natum +Anno Christi +Anno Domini +Anno mundi +Anno post Romam conditam +Annus horribilis +Ante bellum +Ante Christum Natum +Ante diem +Ante factum +Ante mare undae +Ante meridiem +Ante nuptias donatio +Ante quem +Anterioritas +Apparatus criticus +Appellatio +Appendix +Appetitus societatis +Aqua bulliens +Aqua destillata +Aqua et igni alicui interdicere +Aqua et ignis +Aqua et panis, vita canis +Aqua fontana +Aqua [cavat] lapidem non vi, sed saepe cadendo +Aqua pluvialis +Aqua pura +Aqua tophana +Aqua vitae +Aquae et ignis interdictio, hoc est exillum +Aquae potoribus +Aquila non captat muscas +Arbiter elegantiae +Arboretum +Arcades ambo +Argenteis hastis pugnare +Argentum nitricum +Argumenta ambigua +Argumenta ponderantur, non numerantur +Argumentum a contrario +Argumentum a posteriori +Argumentum a priori +Argumentum a silentio +Argumentum a tuto +Argumentum achilleum +Argumentum ad crumenam +Argumentum ad hominem +Argumentum ad ignorantiam +Argumentum ad invidia +Argumentum ad judicum +Argumentum ad misericordiam +Argumentum ad populum +Argumentum ad rem +Argumentum ad verecundiam +Argumentum ad veritatem +Argumentum ambiguum (communis) +Argumentum baculinum +Argumentum ex consensu gentum +Argumentum ex silentio +Argumentum externum +Argumentum internum +Argumentum legis +Argumentum primarium (palmarium) +Arma virumque cano +Arrectis auribus +Ars adeo latet arte sua +Ars amandi +Ars est celare artem +Ars et norma interpretandi naturam +Ars gubernandi +Ars moriendi +Ars logica +Ars longa, vita brevis +Ars oratoria +Ars poetica +Ars sacra +Ars una, species mille +Ars vitae +Artes ingenuae (liberales) +Artes molliunt mores +Articulo mortis +Articulus +Articulus secretissimus +Artificiosa natura +Artium magister +Asa foetida +Asini exiguo pabulo vivunt +Asinos non curo +Asinus asinorum in saecula saeculorum +Asinus asinum fricat +Asinus Buridani inter duo prata +Associatio idearum +Astra inclinant, non necessitant +Asylum ignorantiae +Atrium mortis +Atrophia nervorum +Auctoritas foris +Auctoritas rei judicatae +Audacter calumniare, semper aliquid haeret +Audentes fortuna juvat +Audiatur et altera pars +Auguror nec me fallit augurium, historias tuas immortales futuras +Aura popularis +Aurea mediocritas +Aures habent, et non audient +Auri sacra fames +Auribus teneo lupum +Aurora borealis +Aurora musis amica est +Аurum nostrum non est aurum vulgi +Aurum potestas est +Auspicia sunt fausta +Auspicium melioris aevi +Aut bene, aut nihil +Aut bibat, aut abeat +Aut Caesar, aut nihil +Aut cum scuto, aut in scuto +Aut deus, aut natura +Aut non tentaris, aut perfice +Aut disce, aut discede +Aut prodesse volunt aut delactare poetae +Aut vincere, aut mori +Ave +Ave, Caesar, morituri te salutant +Ave Maria +Ave ac vale +Ave verum corpus +Avibus bonis +Bacchum Nymphis temperare +Barba crescit caput nescit +Barba non facit philosophum +Barbam video, sed philosophum non video +Barbarus hic ego sum, quia non intelligor ulli +Beata stultica +Beatae plane aures, quae non vocem foris sonantem, sed intus auscultant veritatem docentem +Beati pauperes spiritu +Beati possidentes +Beatudio non est virtutis praemium, sed ipsa virtus +Beatus ille, qui procul negotiis +Bella matribus detestata +Bellum internecivum +Bellum omnium contra omnes +Bene diagnoscitur, bene curatur +Bene misceatur +Bene placito +Bene qui latuit, bene vixit +Bene tritum +Bene valete +Benevole lector +Benevolentiae captande causa +Bestiolae, quae unum tantum diem vivunt +Biblia pauperum +Bibliothecae scriptorum +Bis dat qui cito dat +Bis repetitia placent +Bis vincit qui se vincit in victoria +Bona adventica +Bona dicta +Bona fama divitiis est potior +Bona fide +Bona fides +Bona hereditaria +Bona mente +Bona opinio homini tuttior pecunia est +Bona venia vestra +Bonae fidei possesio +Boni homines +Bonis auspiciis +Bono modo +Bono sensu +Bonum publicum +Bonum vinum lactificat cor hominus +Bonus eventus +Bonus ordo +Bonus pater familias +Bonus ver semper tiro est +Breves vibrantesque sententiae +Brevi manu +Brevis esse laboro, obscurus fio +Bruta fulmina +Cacatum non est pictum +Cadit quaestio +Cadmea victoria +Caedite eos. Novit enim Dominus qui sunt eius +Caelo tonantem credidimus Jovem Regnare +Caelum, non animum mutant, qui trans mare currunt +Caesar ad Rubiconem +Caesar citra Rubiconem +Caesarem licet stantem mori +Caesarem vehis Caesarisque fortunam +Caesar non supra grammaticos +Caetera activitati +Caetera desiderantur +Caetera desunt +Calamitas virtutis occasio +Callida junctura +Calumniare audacter, semper aliquid haeret +Calvitium non est vitium sed prudentiae judicium +Camera clara +Camera lucida +Camera obscura +Camica santa +Candidior lacte +Canina facundia +Canis a non canendo +Cantabit vacuus coram latrone viator +Capitis deminutio +Captatio benevolentiae +Caput atro carbone notatum +Caput mortuum +Caput mundi +Caput orbi +Caritas humani generis +Caritas omnia credit +Carmen famosum +Carmen horrendum +Carmina nulla canam +Carmina morte carent +Caro est qui securis est +Carpe angelum +Carpe diem +Carpent tua poma nepotes +Carthago delenda est +Casta est quam nemo rogavit +Castis omnia casta +Casum sentit dominus +Casus a nullo praestantur +Casus belli +Casus conscietiae +Casus foederis +Casus incurabilis +Catena scientiarum +Causa activa +Causa bibendi +Causa causalis +Causa civilis +Causa criminalis +Causa efficiens +Causa essendi +Causa finalis +Causa finita est +Causa formalis +Causa irae +Causa justa +Causa materialis +Causa naturalis +Causa occasionalis +Causa prima +Causa principalis +Causa privata +Causa proxima, non remota spectatur +Causa sine qua non +Causa sufficiens +Causa sui +Cautio judicatum solvi +Cave canem +Cave hominem unius libri +Cave ne cadas +Caveant consules! +Cedant arma togae +Cedo majori +Censor morum +Certa de causa +Certa viriliter sustine patienter +Cessante causa, cessat effectus +Cessio bonorum +Ceteris paribus +Ceterum censeo +Charta non erubescit +Cibus, onus et virga asino +Circulus in probando +Circulus vitiosus +Citato loco +Citius, altius, fortius! +Cito citissimo +Civiliter mortui +Civis Romanus sum +Civitas Dei +Clara pacta, boni amici +Clari viri +Claris verbis +Classicus scriptor +Classicus testis +Claudite jam rivos, sat prata biberunt +Clausula rebus sic stantibus +Cloaca maxima +Codex chartaceus +Codex manuscriptus +Codex rescriptus +Coeli lumen +Cogita et visa +Cogitationum poenam nemo luit +Cogito ergo sum +Cognata vocabula rebus +Cognatio spiritualis +Coincidencia oppositorum +Collegium musicum +Collegium privatum +Collegium publicum +Colluvies gentium +Columnae Herculis +Commentarius perpetuus +Commodum possessionis +Commodum publicum +Commotio cerebri +Communa bonorem +Communibus annis +Communis opinio +Comoedia togata +Compelle intrate +Compesce mentem +Comple promissum +Compos mentis +Compos sui +Conclamatum est +Concordet sermo cum vitā +Concordia discors +Concordia parvae res crescunt, discordia maximae dilabuntur +Conditio sine qua non +Conditio suspensiva +Confessus pro judicato habetur +Confiteor solum hoc tibi +Consensus facit nuptias +Consensus gentium +Consensus omnium +Consequentia non valet +Consideratis considerandis +Consilio manuque +Consilium abeundi +Consortium omnis vitae +Consuetudo altera natura +Consummatum est! +Consumor aliis inserviendo +Contra bonos mores +Contra Gracchos Tiberim habemus +Contra factum non datur argumentum +Contra jus et fas +Contra tabulas +Contra rationem +Contra contrariis curantur +Contra spem spero +Contra vim mortis non est medicamen in hortis +Contradictio in adjecto +Contradictio in contrarium +Contradictio in re +Contradictio simptomatum +Contraria sunt complementa +Contumacia cumulat poenam +Coram arbitris +Coram hominibus +Coram publico (populo) +Cornu copiae +Corpora non agent nisi soluta +Corpus delicti +Corpus Domini +Corpus juris +Corpus juris civilis (romani) +Corpus simbioticum +Corpus solidum +Corpus vile +Correctis, corrigendis, imprimatur +Corruptio optimi pessima +Corruptissima re publica plurimae leges +Corvus corno oculos non eruit +Crambe repetita +Crassa ignorantia +Crassa Minerva +Credo quia absurdum +Credendo vides +Crescit amor nummi, quantum ipsa pecunia crescit +Crescite, nos qui vivimus, multiplicamini +Crimen laesae majestatis +Crimine ab uno disce omnes +Cui bono? +Cui podest malum? +Cujus regio, ejus lingua +Cujusvis hominis est errare, nullius nisi insipientis in errore perseverare +Culpa fictia +Culpa in eligendo +Culpa in inspiciendo +Culpa lata +Culpa lata dolo camparatur +Culpa lata dolo proxima est +Culpa levis +Culpa poena par esto +Cum commento +Cum Deo +Cum eximia laude +Cum figuris +Cum grano salis +Cum hoc non est propter hoc +Cum moriar, medium solvar et inter opus +Cum notis variorum scriptorum +Cum principia negante non est disputandum +Cum quodam fastidio +Cum res unimum occupavere verba ambiunt +Cum tempore +Cum tot sustineas et tanta negotia solus +Cum vota consultiva +Cuncta supercilio moventis +Cunctando restituit rem +Cupiditas rerum novarum +Cupio omnia, quae vis +Cura te ipsum +Curae leves loquuntur, ingentes stupent +Currente calamo +Curriculum vitae +Cursus honorum +Custodia honesta +Custos morum +Cymini sectores +Damnant quod non intellegunt +Damnatio ad bestias +Damnatio memoriae +Damnatus est +Damnosa quid non imminuit dies? +Damnum emergens +Damoclis gladius +(Timeo) Danaos et dona ferentes +Dat census honores +Dat, donat, dedĭcat (DDD) +Dat veniam corvis, vexat censura columbas +Date obolum Belisario +De capsula totae +De facto +De jure +De gustibus non est disputandum +De lana caprina rixari +De lege ferenda +De lege lata +De lingua stulta incommoda multa +De mare ad mare +De minimis non curat lex +De mortuis aut bene, aut nihil +De mortuis et absentibus nihil nisi bene +De nihilo nihil +De nomine +De novo +De omni re scibili et quibusdam aliis +De omnibus dubito +De possibili et impossibili +De principiis non est disputandum +De profundis +De quo fabula narratur +De rerum natura +De se ipso modifice, de aliis honorifice +De stercore Ennii +De visu et auditu +Decies repetitia placebit +Decipimur specie recti +Debellare superbos +Debes ergo potes +Deductio ad absurdum +Definitio fit per genus et differentiam specificam +Dei gratia +Delegatus non potest delegare +Delicta carnis +Delicta facti permanentis +Delicta facti transeuntis +Delectabile tempus! +Delictum commissionis +Delictum communi juris +Delictum omissionis +Delirium furens +Delirium tremens +Dementia praecox +Dementia senilis +Demonstratio ad oculos +Dente lupus, cornu taurus petit +Dente superbo +Dentibus albis +Deo ignoto +Deos manes placari victimis humanis +Desideria carnis +Desine sperare qui hic intras +Desinit in piscem mulier formosa superne +Destruam et aedificabo +Deus conservat omnia +Deus ex machina +Deus vult +Di meliora +Diagnosis ex juvantibus +Diagnosis ex observatione +Dicendo de cibis dicendum est de moribus +Dicis causa +Dicis gratia +Dictum factum +Dictum sapienti sat est +Dies diem docet +Dies interpellat pro homine +Dies irae +Differentia specifica +Difficile est proprie communia dicere +Difficile est satyram non scribere +Digitus dei est hic! +Dignus est intrare +Dii minorum gentium +Diligentia qualem diligentissimus pater familias abhibet +Diligentia quam im rebus suis +Diluvii testis +Dimidium animae meae +Dimidium facti, qui соерit, habet +Dira necessitas +Dis manibusque sacrum +Disjecta membra +Displicuit nasus tuus +Diurna manu nocturnaquae +Divide et impera +Divinum opus sedare dolorem +Dixi +Dixi et animam levavi +Dixi et animam meam salvavi +Do manus +Do ut des +Do ut facias +Docendo discimus (discitur) +Dolendi modus, timendi non item +Dolus malus +Domi sedet lanam ducit +Domina omnium scientiarum +Dominium bonitarium +Dominus et deus noster sic fieri jubet +Dominus litis +Don gratuit +Donec eris felix, multos numerabis amicos +Donum didacticum +Dramatis personae +Duae res longe sunt difficillimae +Dubia plus torquent mala +Ducunt volentem fata, nolentem trahunt +Dulce est desipere in loco +Dulce et decorum est pro patria mori +Dulce laudari a laudato viro +Dulcis fumus patriae +Dum docemus, discimus +Dum spiro spero +Dum vivimus vivamus +Duo quum faciunt idem, non est idem +Duobus certantibus tertius gaudet +Dura lex sed lex +E pluribus unum +Ea tempestate +Eadem oberrare chorda +Ecce homo +Ecce spectaculum dignum, ad quod respiciat intentus operi suo deus +Ede, bibi, lude +Edictum perpetuum +Edimus ut vivamus, non vivimus ut edamus +Edite, bibite, post mortem nulla voluptas +Effectrix eloquentiae est audientium approbatio +Ego +Ego cogito ergo sum +Ego sum rex Romanus et supra grammaticos +Ego ti intus et in cute novi +Ego versiculos feci, tulit alter honores +Eheu fugaces labuntur anni! +Ei incumbit probatio, qui dicit, non qui negat +Ejus est nolle qui potest velle +Ejusdem farinae +Ejusdem generis +Elegantia juris +Elephanti corio circumtentus est +Eloquentia canina +Emere catullum in sacco +Emunctae naris homo +Ens a se +Ens causa sui +Ens cogitans +Ens rationis +Ens reale +Ens realissimum +Entia metaphysica +Epicuri de grege porcus +Epistola non erubescit +Equo non credite Teucri +Equus Troianus +Ergo +Ergo bibamus +Erit sicut cadaver +Errare humanum est, или Humanum errare est +Errare humanum est sed stultum est in errore perseverare +Eruditio aspera optima est +Est avis in dextra, melior quam quattuor extra +Est deus in nobis +Est modus in rebus +Est quaedam flere voluptas +Esse, vivere, sentire +Et alia +Et cetera +Et fabula partem veri habet +Et fumus patriae dulcis +Et gaudium et solatium in litteris +Et hoc genus omne +Et in Arcadia ego +Et multa alia +Et tu, Brute? +Et premitur ratione animus vincique laborat +Et propter vitam vivendi perdere causas +Et quibusdam aliis +Et semel emissum volat irrevocabile verbum +Etiam periere ruinae +Etiamsi omnes ego non +Eventus docet +Eventus stultorum magister est +Ex abrupto +Ex adverso +Ex aequo +Ex aequo et bono +Ex auditu +Ex cathedra +Ex mero motu +Ex libris +Ex nihilo nihil fit +Ex nunc prout ex tunc +Ex officio +Ex ungue leonem +Exceptio probat regulam in casibus non exceptis +Excitare fluctus in simpulo (см. Буря в стакане) +Excudent alii spirantia mollius aera +Exempli gratia +Experimenta est optima rerum magistra +Experimentum crucis +Extra omnes! +Faber est suae quisque fortunae +Factum est factum +Fac fideli sis fidelis +Facta, non verba +Fallaces sunt rerum species +Fas est et ab hoste doceri +Fatum +Falax species rerum +Feci quod potui, faciant meliora potentes +Fecit +Ferox verbis +Ferro et igni; Igni et ferro +Festina lente +Fiat iustitia, et pereat mundus! +Fiat lux! +Fiat Roma, et ubi illa nunc est? +Fidei defensor +Fidelis et fortis +Finis coronat opus +Finis sanctificat media +Fortes fortuna adiuvat +Forum delicti +Fortis imaginatio generat casum +Fortuna caeca est +Fuimus Troes, fuit Ilium +Furor Teutonicus +Furtum manifestum +Frustra fit per plura quod potest fieri per pauciora +Gaudeamus igitur, juvenes dum sumus! +Genius loci +Gratis +Gutta cavat lapidem +Habeas corpus +Habemus Papam +Hannibal ante portas +Hic bibitur +Heu quam est timendus qui mori tutus putat +Hic locus est ubi mors gaudet succurrere vitae +Hic et nunc +Hic portus salutis +Hic Rhodus, hic salta +Hic sunt dracones +Hic sunt leones +Hoc fac et vinces +Hoc volo, sic jubeo, sit pro ratione voluntas +Hodie mihi, cras tibi +Homo homini lupus est +Homo proponit, sed Deus disponit +Homo Sapiens non urinat in ventum +Homo sum, humani nihil a me alienum puto +Honores mutant mores, sed raro in meliores +Honoris causa +Horribile dictu +Humanum errare est +Ibi semper est victoria, ubi concordia est +Ibi victoria, ubi concordia +Ibidem +Idem per idem +Id est +In bono veritas +Iesus Nazarenus, Rex Iudaeorum +Igni et ferro +Ignoramus et ignorabimus +Ignorantia non excusat +Ignoratio elenchi +Ignorantia non est argumentum +Imago animi vultus est +Imperare sibi maximum imperium est +Imperatorem stantem mori oportet +In absentia +In angustiis amici apparent +In camera +In coena domini +In contumaciam +In corpore +Indignus qui inter mala verba +In dubio pro reo +In flagrante delicto +In foro scientiae +Ingenium mala saepe movent +In infinitum +In hoc signo vinces +Injuria realis +Injuria verbalis +Injuriam faclius fasias guam feras +In memoriam +In nomine Patris, et Filii, et Spiritus Sancti, (amen) +Innocens credit omni verbo +In partem salari +In pricipio erat verbum +In propria persona +In propia causa nemo jundex +In rerum natura +In saecula saeculorum +In silico +In situ +Inter alia +Inter arma silent Musae +Interdum lacriumae pondera vocis habent +In utero +In vacuo +Invia est in medicina via sine lingua latina +Invia virtuti nulla est via +In vino veritas +Inutile terrae pondus +Ipsa se velocitas implicat +In vitro +In vivo +Ipse dixit +Ipso facto +Iura novit curia +Ira furor brevis est +Ira odium generat, concordia nutrit amorem +Irreparabilium (iprepara rabilium) felix oblivio rerum +Is fecit cui prodest +Jamque opus exegi quod nec Jovis ira, nec ignis, nec poterit ferrum, nec edax abolere vetustas +Judex damnatur, cum nocens absolvitur +Juris praecepta sunt haec: honeste vivere, alterum non laedere, suum cuique tribuere +Jus primae noctis +Jus primae occupationis +Jus sanguinis +Jus soli +Jus vitae ac necis +Justitia regnorum fundamentum +Labor omnia vincit +Labor est etiam ipse voluptas +Lassata viris necdum satiata recessit +Laborare est orare +Lectori benevolo salutem, L.B.S. +Legum servi sumus ut liberi esse possimus +Letum non omnia finit +Legio nomen mihi est +Levis est labor omnis amanti +Lex specialis derogat generali +Lex posterior derogat legi priori +Lex superior derogat legi inferiori +Lex talionis +Liberum veto +Libro ultimo +Licentia poetica +Littera scripta manet +Litterae humaniores +Locus regit actum +Lorem ipsum +Longa manus calami +Lege artis +Lucri bonus est odor ex re qualibet +Lupus in fabilus +Lupus non mordet lupum +Lupus pilum mutat, non mentem +Lux in tenebris +Lux ex tenebris +Magni nominis umbra +Magnum opus +Malum discordiae +Malum se ipsum devorat +Manifestum non eget probatione +Maniae infinitae sunt species +Manus manum lavat +Margaritas ante porcos +Matrimonium iustum +Mea culpa +Mea virtute me involvo +Medicus curat, natūra sanat +Medius terminus +Memento mori +Memento vivere +Memento quia pulvis es +Mens sana in corpore sano +Metri causa +Metus, dolor, mors ac formidines +Misericórdia +Modus operandi +Modus vivendi +More majorum +Mortem effugere nemo potest +Multum vinum bibere +Multi multa; Nemo omnia novit +Multa paucis +Mutatis mutandibus +Nam vitiis nemo sine nascitur +Natura abhorret vacuum +Naturalia non sunt turpia +Navigare necesse est, vivere non est necesse +Naviget, haec summa est +Nec gemino bellum Trojanum orditur ab ovo +Nec nostri saeculi est +Nec Deus intersit +Nec sutor ultra crepidam +Nemo debet bis puniri pro uno delicto +Nemo debet esse judex in propria causa +Nemo me impune lacessit +Nemo omnia potest scire +Nemo solus satis sapit +Ne sutor supra crepidam +Nihil admirari +Nihil habeo, nihil timeo +Nihil habeo, nihil curo +Nihil habenti nihil deest +Nihil verum est licet omnia +Nil aliud scit necessitas quam vincere +Nil inultum remanebit +Nil sancti +Nil satis nisi optimum +Nolens volens +Nomen est omen +Nomen Nescio +Nomina sunt odiosa +Non bis in idem +Non curatur, qui curat +Non moritura +Non olet (см. Деньги не пахнут) +Non progredi est regredi +Non rex est lex, sed lex est rex +Non scholae, sed vitae discimus +Non tam praeclarum est scire Latine, quam turpe nescire +Nosce te ipsum +Nota bene +Novus ordo seclorum +Nullum crimen sine poena, nulla poena sine lege, nullum crimen sine poena legali +Nusquam est qui ubique est +Occasio receptus difficiles habet +Oderint, dum metuant +Odi et amo +Omnia homini, dum vivit, speranda sunt +Omne vivum ex ovo +Omnes vulnerant, ultima necat +Omnia mea mecum porto +Omnia mutantur, nihil interit +Omnia orta cadunt +Omnia praeclara rara +Omnia vincit amor et nos cedamus amori +Omnis homo mendax +Omnis ars imitatio est naturae +Omnium consensu +Ora et labora +Orbis terrarum +Ordo ab chao +O sancta simplicitas +O tempora, o mores! +Otia dant vitia +Otium post negotium +Pacta sunt servanda +Panem et circenses +Pater noster +Pax optima rerum est +Pecuniae oboediunt omnia +Per aspera ad astra +Per Iovem +Periculum in mora +Perpetuum mobile +Per se +Persona grata +Persona non grata +Persona suspecta +Personae dramatis +Pes sic tendatur ne lodix protereatur +Petitio principii +Pictoribus atque poetis +Pie Jesu Domine, dona eis requiem +Plus ultra +Poëma +Poëtae nascuntur, oratōres fiunt +Porta itineri longissima +Post coitum omne animal triste est +Post factum +Post hoc ergo propter hoc +Post hoc non est propter hoc +Post mortem +Post prandium stabis, post cenam ambulabis +Post scriptum +Post tenebras lux +Potius sero quam nunquam +Praemonitus praemunitus +Primo +Primum non nocere +Primus inter pares +Pro forma +Pro pace +Pro patria mori +Pro poena +Pro tempore +Probatuum est +Procul negotiis +Quae medicamenta non sanat, ferrum sanat; Quae ferrum non sanat, ignis sanat. Quae vero ignis non sanat, insanabilia reputari oportet +Qualis artifex pereo! +Quantum satis +Qui nimium probat, nihil probat. +Qui non laborat, non manducet +Qui non proficit deficit. +Qui pro quo +Qui scribit, bis legit +Qui seminat mala, metet mala +Qui sine pecato est? +Qui ventum seminat, turbinem metet +Quid dubitas, ne faceris +Quid est veritas? +Quid pro quo +Quid timeas? Caesarem vehis Caesarisque fortunam +Quis? Quid? Ubi? Quibus auxiliis? Cur? Quomodo? Quando? +Quis custodiet ipsos custodes? +Quo vadis? +Quod deus bene vertat +Quod erat demonstrandum +Quod gratis asseritur, gratis negatur +Quod licet Jovi, non licet bovi +Quod scripsi, scripsi +Quot capita, tot sententiae +Quo usque pro Roma ibis? +Radices litterarum amarae sunt, fructus dulces +Rara est [adeo] concordia formae atque pudicitiae +Rebus sic stantibus +Reddite quae sunt Caesaris Caesari, et quae sunt Dei Deo +Reductio ad absurdum +Regula certa datur: bene qui stat, non moveatur +Repetitio est mater studiorum +Requiescat in pace +Requiem aeternam dona eis, Domine +Res Publica +Respice finem +Respondeat superior +Reti ventos venari +Rex regnat, sed non gubernat +Roma locuta, causa finita +Salus populi suprema lex +Sancta sanctorum +Sapere aude +Sapienti sat +Scientia potentia est +Scire leges non hoc est verba earum tenere, sed vim ac potestatem +Secundo +Sed alia tempora +Sed semel insanivimus omnes +Sede Vacante +Sedia Gestatoria +Sed non quo ad hanc +Semper idem +Semper in motu +Semper fidelis +Senatus bestia, senatores boni viri +Senatus Populusque Romanus (S.P.Q.R) +Sententia absolutoria +Sero venientibus ossa +Serva me, servanto te +Servus Servorum Dei +Si parva licet componere magnis +Si vales, bene est; Ego valeo (SVBEEV) +Si vis amari, ama! +Si vis pacem, para bellum +Si vis vincere, disce pati +Sic! +Sic itur ad astra +Sic transit gloria mundi +Sic semper tyrannis +Silentium est aurum +Silentium videtur confessio +Similia similibus curantur +Sine causa +Sine cura +Sine ira et studiо +Sit tibi terra levis +Sitio +Sola Scriptura +Soli Deo gloria +Sol lucet omnibus +Solum debilis mori debent +Solus cum sola, in loco remoto, non cogitabuntur orare «Pater noster» +Status quo +Sub rosa +Sudore et sanguine +Sui generis +Suis quaeque temporibus +Summa summarum +Supra nos Fortuna negotia curat +Supremum vale +Sursum corda +Suum cuique +Tabula rasa +Tacito consensu +Tale quale +Te amo est verum +Tempora mutantur et noc mutamur in illis +Tempus edax rerum +Tempus fugit +Tempora labuntur, tacitisque senescimus annis +Tertium non datur +Terra incognita +Terra nullius +Testis unus +Timeo Danaos et dona ferentes +Toties quoties +Totum revolutum +Totus floreo +Trahit sua quemque voluptas +Tres faciunt collegium +Tres muliers faciunt nundias +Ubi bene, ibi patria +Ubi concordia, ibi victoria +Ubi culpa est ibi poena subbesse debet +Ubi nil vales, ibi nil velis +Ubi mel, ibi apes +Ubi mel, ibi fel +Ubi pus, ibi incisio +Ultima ratio +Ultra posse nemo obligatur +Una voce +Unum et idem +Unus pro omnibus, omnes pro uno +Urbi et Orbi +Usus est optimus magister +Utile dulce miscere +Ut tensio sic vis +Ut desint vires, tamen est laudanda voluntas +Uti, non abuti +Vale +Vade retro, Satana +Vae victis +Vanitas vanitatum et omnia vanitas +Varietas delectat +Veni, vidi, vici +Verba magistri +Verba volant, scripta manent +Verbatim +Verte +Verum est quod pro salute fit mendacium +Veto +Versus +Via est vita +Viam supervadet vadens +Vice versa +Vide licet (Vide licet) +Videre majus quiddam +Vince in bono malum +Vinum +Vinum verba ministrat +Viribus unitis +Vis unita fortior +Vita brevis ars longa +Vita sine libertate, nihil +Vita sine litteris mors est +Vitae sal +Vivenda +Vivere est cogitare +Vi veri universum (veniversum) vivus vici +Volens nolens +Volo ergo sum +Volo, non valeo +Votum separatum +Vox populi vox Dei diff --git a/data/sample_config.json b/data/sample_config.json new file mode 100644 index 0000000..00bc2dc --- /dev/null +++ b/data/sample_config.json @@ -0,0 +1,61 @@ +{ +# all cached will go there, they named after module name + "server" : "127.0.0.1", + "port" : "6667", + "ssl" : 0, + "nick" : "aleesa", + "connect_cmd" : "/join #a\n/join #b", + +# where caches go + "cachedir" : "data/cache", + +# unprivileged system user to run bot as + "user" : "nobody", + +# where to store brains + "braindir": "data/brains", + +# bot commands will begin with this symbol + "csign": "!", + +# stderr + "log" : "/var/log/aleesa-irc-bot/error.log", +# stdout + "debug_log" : "/dev/null", + +# ditto + "pid" : "/var/run/aleesa-irc-bot/aleesa-irc-bot.pid", + +# where to store brain with generated latin mumble + "lat" : { + "brain" : "data/lat/brain.sqlite", + "src" : "data/lat.txt" + }, + + "karma" : { + "dir" : "data/karma" + }, + + "friday" : { + "dir" : "data/friday", + "src" : "data/friday.txt" + }, + + "fortune" : { + "dir" : "data/fortune", + "srcdir" : "data/fortune_src" + }, + + "openweathermap" : { + "appid": "get_it_on_openweathermap.org" + }, + + "image": { + "dir" : "data/image", + "flickr" : { + "consumer_key" : "md5-like_hash", + "consumer_secret" : "some_hash-like_string", + "verifier": "some_hash-like_string" + } + } +} diff --git a/lib/Bot/IRC.pm b/lib/Bot/IRC.pm new file mode 100644 index 0000000..dc95257 --- /dev/null +++ b/lib/Bot/IRC.pm @@ -0,0 +1,1455 @@ +package Bot::IRC; +# ABSTRACT: Yet Another IRC Bot + +use 5.014; +use exact; + +use Encode qw (_utf8_on _utf8_off encode_utf8 decode_utf8); +use Daemon::Device; +use Date::Format 'time2str'; +use IO::Socket::IP -register; +use IO::Socket::SSL; +use Time::Crontab; + +our $VERSION = '1.35'; # VERSION + +sub new { + my $class = shift; + my $self = bless( {@_}, $class ); + + croak('Odd number of elements passed to new()') if ( @_ % 2 ); + croak('connect/server not provided to new()') + unless ( ref $self->{connect} eq 'HASH' and $self->{connect}{server} ); + + $self->{spawn} ||= 2; + + $self->{connect}{nick} //= 'bot'; + $self->{connect}{name} //= 'Yet Another IRC Bot'; + $self->{connect}{port} ||= 6667; + + $self->{daemon} //= {}; + $self->{daemon}{name} //= $self->{connect}{nick}; + $self->{daemon}{pid_file} //= $self->{daemon}{name} . '.pid'; + + $self->{nick} = $self->{connect}{nick}; + + $self->{hooks} = []; + $self->{ticks} = []; + $self->{helps} = {}; + $self->{loaded} = {}; + + $self->{send_user_nick} ||= 'on_parent'; + croak('"send_user_nick" optional value set to invalid value') if ( + $self->{send_user_nick} ne 'on_connect' and + $self->{send_user_nick} ne 'on_parent' and + $self->{send_user_nick} ne 'on_reply' + ); + + $self->load( + ( ref $self->{plugins} eq 'ARRAY' ) ? @{ $self->{plugins} } : $self->{plugins} + ) if ( $self->{plugins} ); + + return $self; +} + +sub run { + my $self = shift; + my $commands = \@_; + + $self->{socket} = ( ( $self->{connect}{ssl} ) ? 'IO::Socket::SSL' : 'IO::Socket::IP' )->new( + PeerAddr => $self->{connect}{server}, + PeerPort => $self->{connect}{port}, + Proto => 'tcp', + Family => ( $self->{connect}{ipv6} ? AF_INET6 : AF_INET ), + Type => SOCK_STREAM, + SSL_verify_mode => SSL_VERIFY_NONE, + ) or die $!; + + if ( $self->{send_user_nick} eq 'on_connect' ) { + $self->{socket}->print("USER $self->{nick} 0 * :$self->{connect}{name}\r\n"); + $self->{socket}->print("NICK $self->{nick}\r\n"); + } + + try { + $self->{device} = Daemon::Device->new( + parent => \&_parent, + child => \&_child, + on_message => \&_on_message, + spawn => $self->{spawn}, + daemon => $self->{daemon}, + data => { + self => $self, + commands => $commands, + passwd => $self->{passwd}, + }, + ); + } + catch { + my $e = $_ || $@; + croak("Daemon device instantiation failure: $e"); + }; + + $self->{device}->run; +} + +sub note { + my ( $self, $msg, $err ) = @_; + _utf8_on $msg; + chomp($msg); + $msg = '[' . time2str( '%d/%b/%Y:%H:%M:%S %z', time() ) . '] ' . $msg . "\n"; + + if ($err) { + die $msg if ( $err eq 'die' ); + warn $msg; + } + else { + print $msg; + } + + return; +} + +sub _parent { + my ($device) = @_; + my $self = $device->data('self'); + my $session = { start => time }; + my $delegate = sub { + my ($random_child) = + map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, rand() ] } + @{ $device->children }; + + $device->message( $random_child, @_ ); + }; + + local $SIG{ALRM} = sub { + alarm 1; + my $time = time; + + for ( + grep { + ref $_->{timing} and ( $time % 60 == 0 ) and $_->{timing}->match($time) or + not ref $_->{timing} and ( ( $time - $session->{start} ) % $_->{timing} == 0 ) + } @{ $self->{ticks} } + ) { + try { + $_->{code}->($self); + } + catch { + my $e = $_ || $@; + warn "Tick execution failure: $e\n"; + }; + } + }; + + local $SIG{__WARN__} = sub { note( undef, $_[0], 'warn' ) }; + local $SIG{__DIE__} = sub { note( undef, $_[0], 'die' ) }; + + srand(); + my @lines; + + try { + if ( $self->{send_user_nick} eq 'on_parent' ) { + $self->say("USER $self->{nick} 0 * :$self->{connect}{name}"); + $self->say("NICK $self->{nick}"); + } + + while ( my $line = $self->{socket}->getline ) { + $line =~ s/\003\d{2}(?:,\d{2})?//g; # remove IRC color codes + $line =~ tr/\000-\037//d; # remove all control characters + + $self->note($line); + chomp($line); + + if ( not $session->{established} ) { + if ( not $session->{user} ) { + if ( $self->{send_user_nick} eq 'on_reply' ) { + $self->say("USER $self->{nick} 0 * :$self->{connect}{name}"); + $self->say("NICK $self->{nick}"); + } + elsif ( $self->{send_user_nick} eq 'on_connect' ) { + $self->note("<<< USER $self->{nick} 0 * :$self->{connect}{name}\r\n"); + $self->note("<<< NICK $self->{nick}\r\n"); + } + $session->{user} = 1; + } + if ( $line =~ /^ERROR.+onnect\w+ too fast/ ) { + warn "$line\n"; + warn "Sleeping 20 and retrying...\n"; + sleep 20; + $device->daemon->do_restart; + } + elsif ( $line =~ /^ERROR\s/ ) { + warn "$line\n"; + $device->daemon->do_stop; + } + elsif ( $line =~ /^:\S+\s433\s/ ) { + $self->nick( $self->{nick} . '_' ); + } + elsif ( $line =~ /^:\S+\s001\s/ ) { + $self->say($_) for ( map { + my $command = $_; + $command =~ s|^/msg |PRIVMSG |; + $command =~ s|^/(\w+)|uc($1)|e; + $command; + } @{ $device->data('commands') } ); + + $self->join; + $session->{established} = 1; + alarm 1 if ( @{ $self->{ticks} } ); + } + } + + shift @lines while ( @lines > 10 ); + my $now = time(); + + unless ( grep { $_->{line} eq $line and $_->{time} + 1 > $now } @lines ) { + $delegate->($line); + } + else { + $self->note("### Skipped repeated line: $line"); + } + + push @lines, { line => $line, time => $now }; + } + } + catch { + my $e = $_ || $@; + warn "Daemon parent loop failure: $e\n"; + kill( 'KILL', $_ ) for ( @{ $device->children } ); + }; +} + +sub _child { + local $SIG{__WARN__} = sub { note( undef, $_[0], 'warn' ) }; + local $SIG{__DIE__} = sub { note( undef, $_[0], 'die' ) }; + + srand(); + sleep 1 while (1); +} + +sub _on_message { + my $device = shift; + my $self = $device->data('self'); + my $passwd = $device->data('passwd'); + + for my $line (@_) { + if ( $line =~ /^>>>\sNICK\s(.*)/ ) { + $self->{nick} = $1; + next; + } + elsif ( $line =~ /^:\S+\s433\s/ ) { + $self->nick( $self->{nick} . '_' ); + next; + } + + $self->{in} = { map { $_ => '' } qw( line source nick user server command forum text ) }; + $self->{in}{$_} = 0 for ( qw( private to_me ) ); + $self->{in}{line} = $line; + + if ( $line =~ /^(ERROR)\s/ ) { + warn $line . "\n"; + } + elsif ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s(\S+)\s:(.*)/ ) { + @{ $self->{in} }{ qw( nick user server command forum text ) } = ( $1, $2, $3, $4, $5, $6 ); + $self->{in}{full_text} = $self->{in}{text}; + } + elsif ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s:(.*)/ ) { + @{ $self->{in} }{ qw( nick user server command text ) } = ( $1, $2, $3, $4, $5 ); + ( $self->{in}{forum} = $self->{in}{text} ) =~ s/^:// + if ( $self->{in}{command} eq 'JOIN' or $self->{in}{command} eq 'PART' ); + } + elsif ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s(\S+)\s(.*)/ ) { + @{ $self->{in} }{ qw( nick user server command forum text ) } = ( $1, $2, $3, $4, $5, $6 ); + } + elsif ( $line =~ /^:(\S+?)!~?(\S+?)@(\S+?)\s(\S+)\s(\S+)/ ) { + @{ $self->{in} }{ qw( nick user server command forum ) } = ( $1, $2, $3, $4, $5, $6 ); + } + elsif ( $line =~ /^(PING)\s(.+)/ ) { + @{ $self->{in} }{ qw( command text ) } = ( $1, $2 ); + $self->say( 'PONG ' . $self->{in}{text} ); + next; + } + elsif ( $line =~ /^:(\S+)\s([A-Z]+|\d+)\s(\S+)\s(.*)/ ) { + @{ $self->{in} }{ qw( source command forum text ) } = ( $1, $2, $3, $4 ); + } + else { + warn 'Unparsed line (probably a bug in Bot::IRC; please report it): ', $line . "\n"; + } + + next unless ( $self->{in}{nick} ne $self->{nick} ); + + if ( $self->{in}{command} eq 'PRIVMSG' ) { + $self->{in}{private} = 1 if ( $self->{in}{forum} and $self->{in}{forum} eq $self->{nick} ); + $self->{in}{to_me} = 1 if ( + $self->{in}{text} =~ s/^\s*\b$self->{nick}\b[\s\W]*//i or + $self->{in}{text} =~ s/[\s\W]*\b$self->{nick}\b[\s\W]*$//i or + $self->{in}{private} + ); + } + + if ( $self->{in}{to_me} ) { + if ( $self->{in}{text} =~ /^\s*help\W*$/i ) { + $self->reply_to( + 'Ask me for help with "help topic" where the topic is one of the following: ' . + $self->list( ', ', 'and', sort keys %{ $self->{helps} } ) . '.' + ); + next; + } + elsif ( $self->{in}{text} =~ /^\s*help\s+(.+?)\W*$/i ) { + $self->reply_to( + ( $self->{helps}{$1} || "Couldn't find the help topic: $1." ) + ); + next; + } + elsif ( $self->{in}{text} =~ /Sorry. I don't understand./ ) { + next; + } + } + + hook: for my $hook ( + @{ $self->{hooks} }, + + { + when => { + to_me => 1, + text => qr/^\s*cmd\s+(?\S+)\s+(?.+)$/i, + }, + code => sub { + my ( $bot, $in, $m ) = @_; + + if ( $m->{passwd} and $passwd and $m->{passwd} eq $passwd ) { + $bot->say($_) for ( + map { + my $command = $_; + $command =~ s|^/msg |PRIVMSG |; + $command =~ s|^/(\w+)|uc($1)|e; + $command; + } split( /\s*;\s*/, $m->{cmd} ) + ); + } + + return 1; + }, + }, + + { + when => { + full_text => qr/^\s*$self->{nick}\s*[!\?]\W*$/i, + }, + code => sub { + my ($bot) = @_; + $bot->reply_to('Yes?'); + }, + }, + + { + when => { + to_me => 1, + text => qr/^(?hello|greetings|hi|good\s+\w+)\W*$/i, + }, + code => sub { + my ( $bot, $in, $m ) = @_; + $bot->reply_to( ucfirst( lc( $m->{word} ) ) . '.' ); + }, + }, + + ( map { + { + when => $_, + code => sub { + my ($bot) = @_; + $bot->reply_to(qq{Sorry. I don't understand. (Try "$self->{nick} help" for help.)}); + }, + }, + } ( + { + private => 0, + full_text => qr/^\s*$self->{nick}\s*[,:\->~=]/i, + }, + { + private => 1, + }, + ) ), + + ) { + my $captured_matches = {}; + + for my $type ( keys %{ $hook->{when} } ) { + next hook unless ( + ref( $hook->{when}{$type} ) eq 'Regexp' and + $self->{in}{$type} and $self->{in}{$type} =~ $hook->{when}{$type} or + ref( $hook->{when}{$type} ) eq 'CODE' and $hook->{when}{$type}->( + $self, + $self->{in}{$type}, + { %{ $self->{in} } }, + ) or + ( + defined $self->{in}{$type} and defined $hook->{when}{$type} and + $self->{in}{$type} eq $hook->{when}{$type} + ) + ); + + $captured_matches = { %$captured_matches, %+ } if ( keys %+ ); + } + + my $rv; + try { + $rv = $hook->{code}->( + $self, + { %{ $self->{in} } }, + $captured_matches, + ); + } + catch { + my $e = $_ || $@; + warn "Plugin hook execution failure: $e\n"; + }; + + last if ($rv); + } + } +} + +sub load { + my $self = shift; + + for my $plugin (@_) { + unless ( ref $plugin ) { + if ( $plugin =~ /^:core$/i ) { + $self->load( + 'Ping', + 'Join', + 'Seen', + 'Greeting', + 'Infobot', + 'Functions', + 'Convert', + 'Karma', + 'Math', + 'History', + ); + next; + } + + my $namespace; + for ( + $plugin, + __PACKAGE__ . "::Y::$plugin", + __PACKAGE__ . "::X::$plugin", + __PACKAGE__ . "::$plugin", + ) { + ( my $path = $_ ) =~ s|::|/|g; + + eval "require $_"; + unless ($@) { + $namespace = $_; + last; + } + else { + croak("Plugin load failure: $@") unless ( $@ =~ /^Can't locate $path/ ); + } + } + croak("Unable to find or properly load $plugin") unless ($namespace); + + next if ( $self->{loaded}{$namespace} ); + + $namespace->import if ( $namespace->can('import') ); + croak("$namespace does not implement init()") unless ( $namespace->can('init') ); + + eval "${namespace}::init(\$self)"; + die("Plugin init failure: $@\n") if ($@); + + $self->{loaded}{$namespace} = time; + } + else { + $self->$_( @{ $plugin->{$_} } ) for ( qw( hooks ticks ) ); + $self->$_( $plugin->{$_} ) for ( qw( helps subs ) ); + } + } + + return $self; +} + +sub reload { + my $self = shift; + delete $self->{loaded}{$_} for (@_); + return $self->load(@_); +} + +sub hook { + my ( $self, $when, $code, $attr ) = @_; + + push( + @{ $self->{hooks} }, + { + when => $when, + code => $code, + attr => ( $attr // {} ), + }, + ); + + $self->subs( %{ $attr->{subs} } ) if ( ref $attr->{subs} eq 'HASH' ); + $self->helps( %{ $attr->{helps} } ) if ( ref $attr->{helps} eq 'HASH' ); + + return $self; +} + +sub hooks { + my $self = shift; + $self->hook(@$_) for (@_); + return $self; +} + +sub helps { + my ( $self, @input ) = @_; + + try { + $self->{helps} = { %{ $self->{helps} }, @input }; + } + catch { + $self->note('Plugin helps called but not properly implemented'); + }; + + return $self; +} + +sub tick { + my ( $self, $timing, $code ) = @_; + + push( @{ $self->{ticks} }, { + timing => ( $timing =~ /^\d+$/ ) ? $timing : Time::Crontab->new($timing), + code => $code, + } ); + return $self; +} + +sub ticks { + my $self = shift; + $self->tick(@$_) for (@_); + return $self; +} + +sub subs { + my $self = shift; + + if ( @_ % 2 ) { + $self->note('Plugin helps called but not properly implemented'); + return $self; + } + + my $subs = {@_}; + + for my $name ( keys %$subs ) { + no strict 'refs'; + no warnings 'redefine'; + *{ __PACKAGE__ . '::' . $name } = $subs->{$name}; + } + + return $self; +} + +sub register { + my $self = shift; + $self->{loaded}{$_} = time for (@_); + return $self; +} + +sub vars { + my ( $self, $name ) = @_; + ( $name = lc( substr( ( caller() )[0], length(__PACKAGE__) + 2 ) ) ) =~ s/::/\-/g unless ($name); + return ( defined $self->{vars}{$name} ) ? $self->{vars}{$name} : {}; +} + +sub settings { + my ( $self, $name ) = @_; + return ( defined $name ) ? $self->{$name} : { %$self }; +} + +sub reply { + my ( $self, $message ) = @_; + + if ( $self->{in}{forum} ) { + $self->msg( + ( ( $self->{in}{forum} eq $self->{nick} ) ? $self->{in}{nick} : $self->{in}{forum} ), + $message, + ); + } + else { + warn "Didn't have a target to send reply to.\n"; + } + return $self; +} + +sub reply_to { + my ( $self, $message ) = @_; + return $self->reply( ( ( not $self->{in}{private} ) ? "$self->{in}{nick}: " : '' ) . $message ); +} + +sub msg { + my ( $self, $target, $message ) = @_; + $self->say( "PRIVMSG $target :" . ( ( $message =~ s/^\/me\s+// ) ? "\001ACTION $message\001" : $message ) ); + return $self; +} + +sub say { + my $self = shift; + + for my $s (@_) { + if ($s =~ /^PRIVMSG /) { + foreach my $buf (split_irc_msg ($s)) { + my $string = $buf; + _utf8_off ($buf); + $self->{socket}->syswrite( $buf . "\r\n"); + $self->note("<<< $string"); + sleep 1; + } + } else { + my $string = $s; + _utf8_off ($s); + $self->{socket}->syswrite( $s . "\r\n"); + $self->note("<<< $string"); + } + } + + return $self; +} + +sub nick { + my ( $self, $nick ) = @_; + + if ($nick) { + $self->{nick} = $nick; + $self->{device}->message( $_, ">>> NICK $self->{nick}" ) + for ( grep { $_ != $$ } $self->{device}->ppid, @{ $self->{device}->children } ); + $self->say("NICK $self->{nick}"); + } + return $self->{nick}; +} + +sub join { + my $self = shift; + + $self->say("JOIN $_") for ( + ( not @_ and $self->{connect}{join} ) + ? ( + ( ref $self->{connect}{join} eq 'ARRAY' ) + ? @{ $self->{connect}{join} } + : $self->{connect}{join} + ) + : @_ + ); + + return $self; +} + +sub part { + my $self = shift; + $self->say("PART $_") for (@_); + return $self; +} + +sub list { + my ( $self, $separator, $conjunction ) = ( shift, shift, shift ); + my @list = @_; + + if ( @list > 2 ) { + return CORE::join( $separator, @list[ 0 .. @list - 2 ], $conjunction . ' ' . $list[-1] ); + } + elsif ( @list > 1 ) { + return $list[0] . ' ' . $conjunction . ' ' . $list[1]; + } + else { + return $list[0]; + } +} + +sub health { + my ($self) = @_; + + return { + nick => $self->{nick}, + server => $self->{connect}{server}, + port => $self->{connect}{port}, + ssl => $self->{connect}{ssl}, + spawn => $self->{spawn}, + hooks => scalar( @{ $self->{hooks} } ), + ticks => scalar( @{ $self->{ticks} } ), + plugins => scalar( keys %{ $self->{loaded} } ), + }; +} + +sub split_irc_msg { + my $str = shift; + chomp $str; + + # as per https://www.ietf.org/rfc/rfc1459.txt#:~:text=IRC%20messages%20are%20always%20lines,the%20command%20and%20its%20parameters + # we must split string into array of 512 characters including \r\n at the end of the string, in case of utf-8 + my $MAXLEN = 510; + my @ret; + my $prefix = ''; + + my @message = split /:/, $str, 3; + $str = pop @message; + + while (substr($str, 0, 1) eq ' ') { + $str = substr($str, 1); + } + + if ($#message < 1) { + $prefix = CORE::join ':', @message; + $prefix .= ':'; + } else { + $prefix = CORE::join ':', @message; + $prefix .= ', '; + } + + $MAXLEN = $MAXLEN - bytes::length ($prefix) - 100; + + { + do { + my $buflen = bytes::length ($str); + + if ($buflen <= int($MAXLEN)) { + push @ret, sprintf ("%s%s", $prefix, $str); + last; + } + + for (my $len = $MAXLEN; $len > 2; $len--) { + my $buf = substr ($str, 0, $len); + my $strip_offset = length $buf; + + while (substr($buf, 0, 1) eq ' ') { + $buf = substr($buf, 1); + } + + while (substr ($buf, -1, 1) eq ' ') { + chop $buf; + } + + if (bytes::length($buf) <= $MAXLEN) { + push @ret, sprintf ("%s%s", $prefix, $buf); + $str = substr ($str, $strip_offset); + last; + } + } + } while (1); + } + + return @ret; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Bot::IRC - Yet Another IRC Bot + +=head1 VERSION + +version 1.35 + +=for markdown [![test](https://github.com/gryphonshafer/Bot-IRC/workflows/test/badge.svg)](https://github.com/gryphonshafer/Bot-IRC/actions?query=workflow%3Atest) +[![codecov](https://codecov.io/gh/gryphonshafer/Bot-IRC/graph/badge.svg)](https://codecov.io/gh/gryphonshafer/Bot-IRC) + +=head1 SYNOPSIS + + use Bot::IRC; + + # minimal bot instance that does basically nothing except join a channel + Bot::IRC->new( + connect => { + server => 'irc.perl.org', + join => '#test', + }, + )->run; + + # illustrative example of most settings and various ways to get at them + my $bot = Bot::IRC->new( + spawn => 2, + daemon => { + name => 'bot', + lsb_sdesc => 'Yet Another IRC Bot', + pid_file => 'bot.pid', + stderr_file => 'bot.err', + stdout_file => 'bot.log', + }, + connect => { + server => 'irc.perl.org', + port => '6667', + nick => 'yabot', + name => 'Yet Another IRC Bot', + join => [ '#test', '#perl' ], + ssl => 0, + ipv6 => 0, + }, + plugins => [ + ':core', + ], + vars => { + store => 'bot.yaml', + }, + send_user_nick => 'on_parent', # or 'on_connect' or 'on_reply' + ); + + $bot->load( 'Infobot', 'Karma' ); + + ## Example inline plugin structure + # $bot->load({ + # hooks => [ [ {}, sub {}, {} ] ], + # helps => { name => 'String' }, + # subs => { name => sub {} }, + # ticks => [ [ '0 * * * *', sub {} ] ], + # }); + + $bot->run; + +=head1 DESCRIPTION + +Yet another IRC bot. Why? There are so many good bots and bot frameworks to +select from, but I wanted a bot framework that worked like a Unix service +out-of-the-box, operated in a pre-fork way to serve multiple concurrent +requests, and has a dirt-simple and highly extendable plugin mechanism. I also +wanted to keep the direct dependencies and core bot minimalistic, allowing as +much functionality as possible to be defined as optional plugins. + +=head2 Minimal Bot + +You can have a running IRC bot with as little as: + + use Bot::IRC; + + Bot::IRC->new( + connect => { + server => 'irc.perl.org', + }, + )->run; + +This won't actually do much apart from connecting to the server and responding +to pings, but it's useful to understand how this works. Let's say you place the +above code into a "bot.pl" file. You start the bot with: + + ./bot.pl start + +This will startup the bot. Command-line commands include: start, stop, restart, +reload, status, help, and so on. (See L for more details.) + +=head2 Pre-Forking Device + +When the bot is started, the parent process will fork or spawn a given number +of children workers. You can control their number along with setting locations +for things like PID file, log files, and so on. + + Bot::IRC->new( + spawn => 2, + daemon => { + name => 'bot', + lsb_sdesc => 'Yet Another IRC Bot', + pid_file => 'bot.pid', + stderr_file => 'bot.err', + stdout_file => 'bot.log', + }, + )->run; + +(See L for more details.) + +=head1 MAIN METHODS + +The following are the main or primary available methods from this class. + +=head2 new + +This method instantiates a bot object that's potentially ready to start running. +All bot settings can be specified to the C constructor, but some can be +set or added to through other methods off the instantiated object. + + Bot::IRC->new( + spawn => 2, + daemon => {}, + connect => { + server => 'irc.perl.org', + port => '6667', + nick => 'yabot', + name => 'Yet Another IRC Bot', + join => [ '#test', '#perl' ], + ssl => 0, + ipv6 => 0, + }, + plugins => [], + vars => {}, + )->run; + +C will default to 2. Under C, C will default to 6667. +C can be either a string or an arrayref of strings representing channels +to join after connnecting. C is a true/false setting for whether to +connect to the server over SSL. C is also true/false setting for whether +to forcibly connect to the server over IPv6. + +Read more about plugins below for more information about C and C. +Consult L and L for more details about C +and C. + +There's also an optional C parameter, which you probably won't +need to use, which defines when the bot will send the C and initial +C commands to the IRC server. There are 3 options: C, +C (the default), and C. C sends the C +and initial C immediately upon establishing a connection to the IRC +server, prior to the parent runtime loop and prior to children creation. +C (the default) sends the 2 commands within the parent runtime loop +prior to any responses from the IRC server. C (the only option in +versions <= 1.23 of this module) sends the 2 commands after the IRC server +replies with some sort of content after connection. + +=head2 run + +This should be the last call you make, which will cause your program to operate +like a Unix service from the command-line. (See L for +additional details.) + +C can optionally be passed a list of strings that will be executed after +connection to the IRC server. These should be string commands similar to what +you'd type in an IRC client. For example: + + Bot::IRC->new( connect => { server => 'irc.perl.org' } )->run( + '/msg nickserv identify bot_password', + '/msg operserv identify bot_password', + '/oper bot_username bot_password', + '/msg chanserv identify #bot_talk bot_password', + '/join #bot_talk', + '/msg chanserv op #bot_talk', + ); + +=head1 PLUGINS + +To do anything useful with a bot, you have to load plugins. You can do this +either by specifying a list of plugins with the C key passed to +C or by calling C. + +Plugins are just simple packages (or optionally a hashref, but more on that +later). The only requirement for plugins is that they provide an C +method. This will get called by the bot prior to forking its worker children. +It will be passed the bot object. Within C, you can call any number of +plugin methods (see the list of methods below) to setup desired functionality. + + package Your::Plugin; + use strict; + use warnings; + + sub init { + my ($bot) = @_; + + $bot->hook( + { + to_me => 1, + text => qr/\b(?w00t|[l1][e3]{2}[t7])\b/i, + }, + sub { + my ( $bot, $in, $m ) = @_; + $bot->reply("$in->{nick}, don't use the word: $m->{word}."); + }, + ); + } + + 1; + +When you load plugins, you can specify their packages a few different ways. When +attempting to load a plugin, the bot will start by looking for the name you +provided as a sub-class of itself. Then it will look for the plugin under the +assumption you provided it's full name. + + plugins => [ + 'Store', # matches "Bot::IRC::Store" + 'Random', # matches "Bot::IRC::X::Random" + 'Thing', # matches "Bot::IRC::Y::Thing" + 'My::Own::Plugin', # matches "My::Own::Plugin" + ], + +An unenforced convention for public/shared plugins is to have non-core plugins +(all plugins not provided directly by this CPAN library) subclasses of +"Bot::IRC::X". For private/unshared plugins, you can specify whatever name you +want, but maybe consider something like "Bot::IRC::Y". Plugins set in the X or +Y subclass namespaces will get matched just like core plugins. "Y" plugins will +have precedence over "X" which in turn will have precedence over core. + +If you need to allow for variables to get passed to your plugins, an unenforced +convention is to do so via the C key to C. + +=head2 Core Plugins + +If you specify ":core" as a plugin name, it will be expanded to load all the +core plugins. Core plugins are all the plugins that are bundled and +distributed with L. + +=over 4 + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=back + +Some core plugins require a storage plugin. If you don't specify one in your +plugins list, then the default L will be used, which is +probably not what you want (for performance reasons). Try +L instead. + + plugins => [ + 'Store::SQLite', + ':core', + ], + +=head1 PLUGIN METHODS + +The following are methods available from this class related to plugins. + +=head2 load + +This method loads plugins. It is the exact equivalent of passing strings to the +C key in C. If a plugin has already been loaded, it'll get +skipped. + + my $bot = Bot::IRC->new( + connect => { server => 'irc.perl.org' }, + plugins => [ 'Store', 'Infobot', 'Karma' ], + ); + + $bot->load( 'Infobot', 'Seen' ); + +From within your plugins, you can call C to specify plugin dependencies +in your plugins. + + sub init { + my ($bot) = @_; + $bot->load('Dependency'); + } + +=head2 reload + +If you need to actually reload a plugin, call C. It operates in the same +was as C, only it won't skip already-loaded plugins. + +=head2 hook + +This is the method you'll call to add a hook, which is basically a message +response handler. A hook includes a conditions trigger, some code to run +when the trigger fires, and an optional additional attributes hashref. + + $bot->hook( + { + to_me => 1, + text => qr/\b(?w00t|[l1][e3]{2}[t7])\b/i, + }, + sub { + my ( $bot, $in, $m ) = @_; + $bot->reply("$in->{nick}, don't use the word: $m->{word}."); + }, + { + subs => [], + helps => [], + }, + ); + +The conditions trigger is a hashref of key-value pairs where the key is a +component of the message and the value is either a value to exact match or a +regular expression to match. + +The code block will receive a copy of the bot, a hashref of key-value pairs +representing the message the hook is responding to, and an optionally-available +hashref of any named matches from the regexes in the trigger. + +The hashref representing the message the hook will have the following keys: + +=over 4 + +=item * + +C: text component of the message + +=item * + +C: IRC "command" like PRIVMSG, MODE, etc. + +=item * + +C: origin location like #channel or the nick who privately messaged + +=item * + +C: 1 or 0 representing if the message is private or in a channel + +=item * + +C: 1 or 0 representing if the message is addressing the bot or not + +=item * + +C: nick of the sender of the message + +=item * + +C: the source server's label/name + +=item * + +C: username of the sender of the message + +=item * + +C: server of the sender of the message + +=item * + +C: full message line/text + +=item * + +C: text component of the message with nick included + +=back + +B If you return a positive +value, all additional hooks are skipped because it will be assumed that this +hook properly responded to the message and no additional work needs to be done. +If the code block returns a false value, additional hooks will be checked as if +this hook's trigger caused the code block to be skipped. + +The optional additional attributes hashref supports a handful of keys. +You can specify C and C, which are exactly equivalent to +calling C and C. (See below.) + +=head2 hooks + +This method accepts a list of arrayrefs, each containing a trigger, code, and +attribute value and calls C for each set. + + ## Example hooks call structure + # $bot->hooks( + # [ {}, sub {}, {} ], + # [ {}, sub {}, {} ], + # ); + +=head2 helps + +This method is how you'd setup any help text you'd like the bot to provide to +users. It expects some number of key-value pairs where the key is the topic +title of the set of functionality and the value is the string of instructions. + + $bot->helps( + seen => 'Tracks when and where people were seen. Usage: seen , hide, unhide.', + join => 'Join and leave channels. Usage: join , leave , channels.', + ); + +In the example above, let's say your bot had the nick of "bot" and you were in +the same channel as your bot and you typed "bot, help" in your IRC channel. The +bot would respond with a list of available topics. Then if you typed "bot, help +seen" in the channel, the bot would reply with the "seen" string of +instructions. If typing directly to the bot (in a private message directly to +the bot), you don't need to specify the bot's name. + +=head2 tick + +Sometimes you'll want the bot to do something at a specific time or at some sort +of interval. You can cause this to happen by filing ticks. A tick is similar to +a hook in that it's a bit of code that gets called, but not based on a message +but based on time. C expects two values. The first is either an integer +representing the number of seconds of interval between calls to the code or a +crontab-like time expression. The second value is the code to call, which will +receive a copy of the bot object. + + $bot->tick( + 10, + sub { + my ($bot) = @_; + $bot->msg( '#test', '10-second interval.' ); + }, + ); + + $bot->tick( + '0 0 * * *', + sub { + my ($bot) = @_; + $bot->msg( '#test', "It's midnight!" ); + }, + ); + +=head2 ticks + +This method accepts a list of arrayrefs, each containing a time value and code +block and calls C for each set. + + $bot->ticks( + [ 10, sub {} ], + [ '0 0 * * *', sub {} ], + ); + +=head2 subs + +A plugin can also provide functionality to the bot for use in other plugins. +It can also override core methods of the bot. You do this with the C +method. + + $bot->subs( + incr => sub { + my ( $bot, $int ) = @_; + return ++$int; + }, + ); + + my $value = $bot->incr(42); # value is 43 + +=head2 register + +There are rare cases when you're writing your plugin where you want to claim +that your plugin satisfies the requirements for a different plugin. In other +words, you want to prevent the future loading of a specific plugin or plugins. +You can do this by calling C with the list of plugins (by full +namespace) that you want to skip. + + $bot->register('Bot::IRC::Storage'); + +Note that this will not block the reloading of plugins with C. + +=head2 vars + +When you are within a plugin, you can call C to get the variables for +the plugin by it's lower-case "simplified" name, which is the plugin's class +name all lower-case, without the preceding "Bot::IRC::" bit, and with "::"s +replaced with dashes. For example, let's say you were writing a +"Bot::IRC::X::Something" plugin. You would have users set variables in their +instantiation like so: + + Bot::IRC->new + plugins => ['Something'], + vars => { x-something => { answer => 42 } }, + )->run; + +Then from within the "Bot::IRC::X::Something" plugin, you would access these +variables like so: + + my $my_vars = $bot->vars; + say 'The answer to life, the universe, and everything is ' . $my_vars->{answer}; + +If you want to access the variables for a different namespace, pass into +C the "simplified" name you want to access. + + my $my_other_vars = $bot->vars('x-something-else'); + +=head2 settings + +If you need access to the bot's settings, you can do so with C. +Supply the setting name/key to get that setting, or provide no name/key to get +all settings as a hashref. + + my $connection_settings_hashref = $bot->settings('connect'); + +=head1 INLINE PLUGINS + +You can optionally inject inline plugins by providing them as hashref. This +works both with C and the C key. + + ## Example inline plugin structure + # $bot->load( + # { + # hooks => [ [ {}, sub {}, {} ], [ {}, sub {}, {} ] ], + # ticks => [ [ 10, sub {} ], [ '0 0 * * *', sub {} ] ], + # helps => { title => 'Description.' }, + # subs => { name => sub {} }, + # }, + # { + # hooks => [ [ {}, sub {}, {} ], [ {}, sub {}, {} ] ], + # ticks => [ [ 10, sub {} ], [ '0 0 * * *', sub {} ] ], + # helps => { title => 'Description.' }, + # subs => { name => sub {} }, + # }, + # ); + +=head1 OPERATIONAL METHODS + +The following are operational methods available from this class, expected to be +used inside various code blocks passed to plugin methds. + +=head2 reply + +If you're inside a hook, you can usually respond to most messages with the +C method, which accepts the text the bot should reply with. The method +returns the bot object. + + $bot->reply('This is a reply. Impressive, huh?'); + +If you want to emote something back or use any other IRC command, type it just +as you would in your IRC client. + + $bot->reply('/me feels something, which for a bot is rather impressive.'); + +=head2 reply_to + +C is exactly like C except that if the forum for the reply is +a channel instead of to a specific person, the bot will prepend the message +by addressing the nick who was the source of the response the bot is responding +to. + +=head2 msg + +Use C when you don't have a forum to reply to or want to reply in a +different forum (i.e. to a different user or channel). The method accepts the +forum for the message and the message text. + + $bot->msg( '#test', 'This is a message for everybody in #test.'); + +=head2 say + +Use C to write low-level lines to the IRC server. The method expects a +string that's a properly IRC message. + + $bot->say('JOIN #help'); + $bot->say('PRIVMSG #help :I need some help.'); + +=head2 nick + +Use C to change the bot's nick. If the nick is already in use, the bot +will try appending "_" to it until it finds an open nick. + +=head2 join + +Use C to join channels. + + $bot->join('#help'); + +If some sort of persistent storage plugin is loaded, the bot will remember the +channels it has joined or parted and use that as it's initial join on restart. + +=head2 part + +Use C to part channels. + + $bot->part('#help'); + +If some sort of persistent storage plugin is loaded, the bot will remember the +channels it has joined or parted and use that as it's initial join on restart. + +=head1 RANDOM HELPFUL METHODS + +The following are random additional methods that might be helpful in your +plugins. + +=head2 list + +This method is a simple string method that takes a list and crafts it for +readability. It expects a separator string, a final item conjunction string, +and a list of items. + + $bot->list( ', ', 'and', 'Alpha', 'Beta', 'Delta', 'Gamma' ); + # returns "Alpha, Beta, Delta, and Gamma" + + $bot->list( ', ', 'and', 'Alpha', 'Beta' ); + # returns "Alpha and Beta" + +=head2 health + +This method returns a hashref of simple key value pairs for different "health" +aspects (or current state) of the bot. It includes things like server and port +connection, number of children, and so on. + +=head2 note + +While in theory you shouldn't ever need to use it, there is a method called +"note" which is a handler for writing to the log and error files. If you +C or C, this handler steps in automatically. If you'd like to +C to STDOUT, which you really shouldn't need to do, then it's best to +call this method instead. The reason being is that the log file is designed to +be parsed in a specific way. If you write whatever you want to it, it will +corrupt the log file. That said, if you really, really want to, here's how you +use C: + + $bot->note('Message'); # writes a message to the log file + $bot->note( 'Message', 'warn' ); # writes a message to the error file + $bot->note( 'Message', 'die' ); # writes a message to the error file the dies + +=head1 SEE ALSO + +You can look for additional information at: + +=over 4 + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=item * + +L + +=back + +=head1 AUTHOR + +Gryphon Shafer + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2016-2021 by Gryphon Shafer. + +This is free software, licensed under: + + The Artistic License 2.0 (GPL Compatible) + +=cut diff --git a/lib/Bot/IRC/OnMessage.pm b/lib/Bot/IRC/OnMessage.pm new file mode 100644 index 0000000..2b5dae7 --- /dev/null +++ b/lib/Bot/IRC/OnMessage.pm @@ -0,0 +1,198 @@ +package Bot::IRC::OnMessage; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Math::Random::Secure qw (irand); +use BotLib qw (Command RandomCommonPhrase); +use BotLib::Conf qw (LoadConf); +use BotLib::Karma qw (KarmaSet); +use BotLib::Util qw (trim utf2sha1); +use Encode qw (_utf8_on); +use Hailo; +our $VERSION = '1.35'; # VERSION + +# Most gears are spinning here. +sub init { + my ($bot) = @_; + my $c = LoadConf (); + my $hailo; + + $bot->hook ( + { + command => 'PRIVMSG', + }, + + sub { + my $bot = shift; + my $msg = shift; + my $text = shift; + + # fix some utf8 flags, that are lost + _utf8_on $msg->{forum}; + _utf8_on $msg->{full_text}; + _utf8_on $msg->{user}; + my $chatid = $msg->{forum}; + + # The main idea is to find out if message contains command. + # I know that this framework contains nifty way to guess commands + # but it detects command when bot mentiond, but'd like to send + # commands via command sign (say, exclamation mark). + if ($msg->{full_text} =~ qr/^\s*\Q$bot->{nick}\E[\,|\:]?\s*$/i) { + # Someone call bot, but says only name, nothing more + $bot->reply_to ('Чего тебе?'); + } elsif ($msg->{full_text} =~ /^\Q$bot->{nick}\E[\,|\:]?\s+(.+)/i) { + # Someone wants to chit-chat with bot, lets use our brain to make an answer. + my $phrase = trim ($1); + + unless (defined $hailo->{$chatid}) { + my $cid = utf2sha1 ($chatid); + $cid =~ s/\//-/xmsg; + my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid; + + $hailo->{$chatid} = eval { + Hailo->new ( + brain => $brainname, + order => 3 + ); + }; + + unless (defined $hailo->{$chatid}) { + $bot->note ($EVAL_ERROR); + return; + } + } + + my $answer = eval { + $hailo->{$chatid}->learn_reply ($phrase); + }; + + unless (defined $answer) { + $bot->note ($EVAL_ERROR); + $answer = RandomCommonPhrase (); + } + + $bot->reply_to ($answer); + } elsif (substr ($msg->{full_text}, -2) eq '++' || substr ($msg->{full_text}, -2) eq '--') { + # Looks like someone wants to adjust karma of the phrase + my @arr = split /\n/, $msg->{full_text}; + + if ($#arr < 1) { + my $answer = eval { + KarmaSet ( + $chatid, + trim ( + substr ( + $msg->{full_text}, + 0, + -2 + ) + ), + substr ($msg->{full_text}, -2) + ); + }; + + if (defined $answer) { + $bot->reply ($answer); + } else { + $bot->note ($EVAL_ERROR); + } + } + } elsif (substr ($msg->{full_text}, 0, 1) eq $c->{csign}) { + my $answer = Command ($msg->{forum}, $msg->{user}, $msg->{full_text}); + + if (defined $answer && $answer ne '') { + foreach my $str (split /\n/, $answer) { + chomp $str; + $str = trim ($str); + + if ($str ne '') { + $bot->reply ($str); + sleep 1; + } + } + } + } else { + # Default action - add phrase to brain reactor as is + unless (defined $hailo->{$chatid}) { + my $cid = utf2sha1 ($chatid); + $cid =~ s/\//-/xmsg; + my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid; + + $hailo->{$chatid} = Hailo->new ( + brain => $brainname, + order => 3 + ); + + unless (defined $hailo->{$chatid}) { + $bot->note ($EVAL_ERROR); + return; + } + } + + $hailo->{$chatid}->learn ($msg->{full_text}); + } + + return 1; + }, + ); + + $bot->helps( + anek => "$c->{csign}anek - рандомный анекдот с anekdot.ru", + анек => "$c->{csign}анек - рандомный анекдот с anekdot.ru", + анекдот => "$c->{csign}анекдот - рандомный анекдот с anekdot.ru", + buni => "$c->{csign}buni - комикс-стрип hapi buni", + bunny => "$c->{csign}bunny - рандомный кролик", + rabbit => "$c->{csign}rabbit - рандомный кролик", + кролик => "$c->{csign}кролик - рандомный кролик", + cat => "$c->{csign}cat - рандомная кошечка", + кис => "$c->{csign}кис - рандомная кошечка", + dig => "$c->{csign}dig - заняться археологией", + копать => "$c->{csign}копать - заняться археологией", + drink => "$c->{csign}drink - какой сегодня праздник?", + праздник => "$c->{csign}праздник - какой сегодня праздник?", + fish => "$c->{csign}fish - порыбачить", + fisher => "$c->{csign}fisher - порыбачить", + рыба => "$c->{csign}рыба - порыбачить", + рыбка => "$c->{csign}рыбка - порыбачить", + рыбалка => "$c->{csign}рыбалка - порыбачить", + f => "$c->{csign}f - рандомная фраза из сборника цитат fortune_mod", + fortune => "$c->{csign}fortune - рандомная фраза из сборника цитат fortune_mod", + фортунка => "$c->{csign}фортунка - рандомная фраза из сборника цитат fortune_mod", + fox => "$c->{csign}fox - рандомная лисичка", + лис => "$c->{csign}лис - рандомная лисичка", + friday => "$c->{csign}friday - а не пятница ли сегодня?", + пятница => "$c->{csign}пятница - а не пятница ли сегодня?", + frog => "$c->{csign}frog - рандомная лягушка", + лягушка => "$c->{csign}лягушка - рандомная лягушка", + horse => "$c->{csign}horse - рандомная лошадка", + лошадь => "$c->{csign}лошадь - рандомная лошадка", + лошадка => "$c->{csign}лошадка - лошадка", + karma => "$c->{csign}karma фраза - посмотреть карму фразы", + карма => "$c->{csign}карма фраза - посмотреть карму фразы", + lat => "$c->{csign}lat - сгенерировать фразу из крылатого латинского выражения", + лат => "$c->{csign}лат - сгенерировать фразу из крылатого латинского выражения", + monkeyuser => "$c->{csign}monkeyuser - комикс-стрип MonkeyUser", + owl => "$c->{csign}owl - рандомная сова", + сова => "$c->{csign}сова - рандомная сова", + ping => "$c->{csign}ping - попинговать бота", + пинг => "$c->{csign}пинг - попинговать бота", + snail => "$c->{csign}snail - рандомная улитка", + улитка => "$c->{csign}улитка - рандомная улитка", + ver => "$c->{csign}ver - написать что-то про версию ПО", + version => "$c->{csign}version - написать что-то про версию ПО", + версия => "$c->{csign}версия - написать что-то про версию ПО", + w => "$c->{csign}w Город - погода в городе", + п => "$c->{csign}п Город - погода в городе", + xkcd => "$c->{csign}xkcd - комикс-стрип с xkcb.ru", + ); + + return 1; +} + +1; + +__END__ diff --git a/lib/BotLib.pm b/lib/BotLib.pm new file mode 100644 index 0000000..cf47bb7 --- /dev/null +++ b/lib/BotLib.pm @@ -0,0 +1,134 @@ +package BotLib; + +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 Math::Random::Secure qw (irand); +use BotLib::Archeologist qw (Dig); +use BotLib::Buni qw (Buni); +use BotLib::Conf qw (LoadConf); +use BotLib::Drink qw (Drink); +use BotLib::Fisher qw (Fish); +use BotLib::Fortune qw (Fortune); +use BotLib::Fox qw (Fox); +use BotLib::Friday qw (Friday); +use BotLib::Image qw (Rabbit Owl Frog Horse Snail); +use BotLib::Karma qw (KarmaGet); +use BotLib::Kitty qw (Kitty); +use BotLib::Lat qw (Lat); +use BotLib::Monkeyuser qw (Monkeyuser); +use BotLib::Util qw (trim utf2sha1); +use BotLib::Weather qw (Weather); +use BotLib::Xkcd qw (Xkcd); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Command RandomCommonPhrase); + +my $c = LoadConf (); + +sub RandomCommonPhrase () { + my @myphrase = ( + 'Так, блядь...', + '*Закатывает рукава* И ради этого ты меня позвал?', + 'Ну чего ты начинаешь, нормально же общались', + 'Повтори свой вопрос, не поняла', + 'Выйди и зайди нормально', + 'Я подумаю', + 'Даже не знаю что на это ответить', + 'Ты упал такие вопросы девочке задавать?', + 'Можно и так, но не уверена', + 'А как ты думаешь?', + ); + + return $myphrase[irand ($#myphrase + 1)]; +} + +sub Command { + my $chatid = shift; + my $chattername = shift; + my $text = shift; + + my $reply; + + if (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') { + my $city = substr $text, 2; + $reply = Weather ($city) =~ tr/\n/ /r; + } elsif (substr ($text, 1) eq 'anek' || substr ($text, 1) eq 'анек' || substr ($text, 1) eq 'анекдот' ) { + $reply = Anek (); + } elsif (substr ($text, 1) eq 'version' || substr ($text, 1) eq 'ver') { + $reply = 'Версия нуль.чего-то_там.чего-то_там'; + } elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') { + $reply = "Попробуй '$c->{nick}, help' без кавычек, должно помочь."; + } elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') { + $reply = Lat (); + } elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') { + $reply = Kitty (); + } elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') { + $reply = Fox (); + } elsif (substr ($text, 1) eq 'frog' || substr ($text, 1) eq 'лягушка') { + $reply = Frog (); + } elsif (substr ($text, 1) eq 'horse' || substr ($text, 1) eq 'лошадь' || substr ($text, 1) eq 'лошадка') { + $reply = Horse (); + } elsif (substr ($text, 1) eq 'snail' || substr ($text, 1) eq 'улитка') { + $reply = Snail (); + } elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') { + $reply = Dig ($chattername); + } elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fisher' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка') { + $reply = Fish ($chattername); + } elsif (substr ($text, 1) eq 'buni') { + $reply = Buni (); + } elsif (substr ($text, 1) eq 'xkcd') { + $reply = Xkcd (); + } elsif (substr ($text, 1) eq 'monkeyuser') { + $reply = Monkeyuser (); + } elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') { + $reply = Drink (); + } elsif (substr ($text, 1) eq 'bunny' || substr ($text, 1) eq 'rabbit' || substr ($text, 1) eq 'кролик') { + $reply = Rabbit (); + } elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') { + $reply = Owl (); + } elsif ((length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) || substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма') { + my $mytext = ''; + + if (length ($text) > 6) { + $mytext = substr $text, 7; + chomp $mytext; + $mytext = trim $mytext; + } else { + $mytext = ''; + } + + $reply = KarmaGet ($chatid, $mytext); + } elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') { + $reply = Friday (); + } elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') { + my $phrase = Fortune (); + $reply = $phrase; + } elsif (substr ($text, 1) eq 'ping') { + $reply = 'Pong.'; + } elsif (substr ($text, 1) eq 'пинг') { + $reply = 'Понг.'; + } elsif (substr ($text, 1) eq 'kde' || substr ($text, 1) eq 'кде') { + my @phrases = ( + 'Нет, я не буду поднимать вам плазму.', + 'Повторяйте эту мантру по утрам не менее 5 раз: "Плазма не падает." И, возможно, она перестанет у вас падать.' + ); + + $reply = $phrases[irand ($#phrases + 1)]; + } elsif (substr ($text, 1) eq '=(' || substr ($text, 1) eq ':(' || substr ($text, 1) eq '):') { + $reply = ':)'; + } elsif (substr ($text, 1) eq '=)' || substr ($text, 1) eq ':)' || substr ($text, 1) eq '(:') { + $reply = ':D'; + } + + return $reply; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Anek.pm b/lib/BotLib/Anek.pm new file mode 100644 index 0000000..5e7fdc7 --- /dev/null +++ b/lib/BotLib/Anek.pm @@ -0,0 +1,76 @@ +package BotLib::Anek; + +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 Encode; +use HTML::TokeParser; +use HTTP::Tiny; +use JSON::XS; + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Anek); + +sub Anek { + my $r; + my $ret = 'Все рассказчики анекдотов отдыхают'; + for (1..3) { + my $ua = HTTP::Tiny->new (timeout => 3); + $r = $ua->get ('https://www.anekdot.ru/rss/randomu.html'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $json; + my $response_text = decode ('UTF-8', $r->{content}); + my @text = split /\n/, $response_text; + + while (my $str = pop @text) { + if ($str =~ /^var anekdot_texts \= JSON/) { + $str = (split /JSON\.parse\(\'/, $str, 2)[1]; + + if (defined $str && length ($str) > 10) { + $json = (split /\';\)/, $str, 2)[0]; + last; + } + } + } + + if (defined $json && length ($json) > 10) { + $json =~ s/\\"/"/g; + $json =~ s/\\\\"/\\"/g; + chop $json; + chop $json; + chop $json; + my $anek = eval { ${JSON::XS->new->relaxed->decode ($json)}[0] }; + + if (defined $anek) { + my @anek = split (/
/, $anek); + $ret = join ("\n", @anek); + } else { + carp (sprintf "[WARN] anekdot.ru server returns incorrect json, full response text message: %s\n", $response_text); + } + } else { + carp (sprintf "[WARN] anekdot.ru server returns unexpected response text: %s\n", $response_text); + } + + } else { + carp (sprintf "[WARN] anekdot.ru server return status %s with message: %s\n", $r->code, $r->message); + } + + return $ret; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Archeologist.pm b/lib/BotLib/Archeologist.pm new file mode 100644 index 0000000..4a3a8be --- /dev/null +++ b/lib/BotLib/Archeologist.pm @@ -0,0 +1,126 @@ +package BotLib::Archeologist; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Math::Random::Secure qw (irand); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Dig); + +sub Dig { + my $name = shift; + + my @artifact = ( + 'амулет Мерлина', + 'библиотеку Ивана Грозного', + 'деревянную плошку', + 'диплока', + 'доски Ноева Ковчега', + 'древний презерватив из бараньей кишки', + 'икону', + 'инсталятор Windows 3.11', + 'истлевший гроб', + 'каменный топор', + 'клад со златом-серебром', + 'кривой нож', + 'ледяную глыбу', + 'лунный грунт', + 'мамонта', + 'мамонтенка', + 'метеорит', + 'мумию фараона Тутанхамона', + 'носки прапорщика (поставит в угол)', + 'обломки грузинской керамики', + 'птеродактиля', + 'рубль с Лениным', + 'рыцарские доспехи', + 'синий мох', + 'скелет', + 'скелет собаки по кличке Беня', + 'тиранозавтра', + 'тотем индейцев', + 'трубу с туркменским газом', + 'скорбь еврейского народа', + 'залежи активированного угля', + 'не очень новый завет', + 'мать леннарта поттеринга', + 'руководство "начинающему археологу"', + 'слово о полку игореве и дело о полку игореве, вместе с игорем', + 'телепрограмму канала A-one', + 'могилу искателя могил', + 'заплесневевший кусок хлеба', + 'преемник радиоприемника', + 'глушитель от ВАЗ-2106', + 'чувство удовлетворения', + 'крота', + 'воспоминания о былой любви', + 'грязистор', + 'египетское мумиё', + 'окаменелый камень', + 'кладку яиц рептилоида', + 'яму', + 'чеснок и стрелы', + 'доллар по 30', + 'несмазанные скрижали', + 'четырелобита', + 'чучело тролля', + 'целое ничего', + ); + + my @location = ( + 'в архивах', + 'в гималаях', + 'в интернете', + 'в кармане', + 'в клумбе', + 'в лунном кратере', + 'во льдах арктики', + 'в морге', + 'в окрестностях погоста', + 'в песочнице', + 'в пустыне Гоби', + 'в пустыне Сахаре', + 'в русле высохшей реки', + 'в собственной памяти', + 'в старом сортире', + 'в углу', + 'в цветочном горшке', + 'на бабушкином огороде', + 'на винчестере', + 'на горе Арарат', + 'на горном плато', + 'на дне моря', + 'на необитаемом острове', + 'на первом слое сумрака', + 'на просторах Украины', + ); + + my $find_probability = irand 100; + my $success_probability = irand 100; + my $artifact_age = irand 15000; + + if ($find_probability <= 20) { + return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[irand ($#location + 1)], $name; + } + + my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)]; + $phrase .= "Вам кажется что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n"; + + if ($success_probability <= 25) { + $phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[irand ($#artifact + 1)], $artifact_age; + } else { + $phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[irand ($#artifact + 1)], $artifact_age; + $phrase .= sprintf 'Извини %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name; + } + + return $phrase; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Buni.pm b/lib/BotLib/Buni.pm new file mode 100644 index 0000000..9bcf07a --- /dev/null +++ b/lib/BotLib/Buni.pm @@ -0,0 +1,58 @@ +package BotLib::Buni; + +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 HTTP::Tiny; +use HTML::TokeParser; + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Buni); + +sub Buni { + my $r; + my $ret = 'Нету Buni'; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('http://www.bunicomic.com/?random&nocache=1'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $p = HTML::TokeParser->new(\$r->{content}); + my @a; + + # additional {} required in order "last" to work properly :) + { + do { + $#a = -1; + @a = $p->get_tag ('meta'); ## no critic (Variables::RequireLocalizedPunctuationVars) + + if (defined $a[0][1]->{property} && $a[0][1]->{property} eq 'og:image') { + $ret = $a[0][1]->{content}; + last; + } + + } while ($#{$a[0]} > 1); + } + } else { + carp (sprintf "[WARN] Server return status %s with message: %s\n", $r->{status}, $r->{reason}); + } + + return $ret; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Conf.pm b/lib/BotLib/Conf.pm new file mode 100644 index 0000000..e222b2a --- /dev/null +++ b/lib/BotLib/Conf.pm @@ -0,0 +1,41 @@ +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 Carp qw (carp); +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 "[FATA] 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 + carp ("[FATA] Unable to read $c: $OS_ERROR\n"); + } + + if ($readlen != $len) { + close $CH; ## no critic (InputOutput::RequireCheckedSyscalls + carp ("[FATA] 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: diff --git a/lib/BotLib/Drink.pm b/lib/BotLib/Drink.pm new file mode 100644 index 0000000..c027b6f --- /dev/null +++ b/lib/BotLib/Drink.pm @@ -0,0 +1,124 @@ +package BotLib::Drink; + +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 Encode; +use CHI; +use CHI::Driver::BerkeleyDB; +use DateTime; +use HTTP::Tiny; +use HTML::TokeParser; +use POSIX qw (strftime); +use BotLib::Conf qw (LoadConf); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Drink); + +my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr); +my $c = LoadConf (); + +sub Drink { + my $drinkCallBack = sub { + my $ret; + my ($dayNum, $monthNum) = (localtime ())[3, 4]; + my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum; + my $r; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ($url, {'Accept-Charset' => 'utf-8', 'Accept-Language' => 'ru-RU'}); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + # TODO: Handle unexpected content + my $p = HTML::TokeParser->new (\$r->{content}); + my @a; + my @holiday; + + do { + $#a = -1; + @a = $p->get_tag ('span'); ## no critic (Variables::RequireLocalizedPunctuationVars) + + if ($#{$a[0]} > 2 && defined $a[0][1]->{itemprop} && $a[0][1]->{itemprop} eq 'text') { + push @holiday,'* ' . decode ('UTF-8', $p->get_trimmed_text ('/span')); + } + + } while ($#{$a[0]} > 1); + + if ($#holiday > 0) { + # cut off something weird, definely not a "holyday" + $#holiday = $#holiday - 1; + } + + if ($#holiday > 0) { + $ret = join "\n", @holiday; + } + } else { + carp (sprintf "[WARN] Server return status %s with message: %s\n", $r->{status}, $r->{reason}); + return undef; + } + + return $ret; + }; + + my $cache = CHI->new ( + driver => 'BerkeleyDB', + root_dir => $c->{cachedir}, + namespace => __PACKAGE__ + ); + + # Those POSIX assholes just forgot to add unix timestamps without TZ offset, so... + my ($mday, $mon, $year) = (gmtime ())[3, 4, 5]; + my $offset = strftime ('%z', gmtime ()); + my $offsetMinutes = (substr $offset, -2) * 60; + my $offsetHours = (substr $offset, 1, 2) * 60 * 60; + my $offsetSign; + + if ((substr $offset, 0, 1) eq '+') { + $offsetSign = 1; + } + + my $expirationDate = DateTime->new ( + year => $year + 1900, + month => $mon + 1, + day => $mday, + hour => 0, + minute => 0, + second => 0 + )->add (days => 1)->strftime ('%s'); + + if ((substr $offset, 0, 1) eq '+') { + $expirationDate = $expirationDate - $offsetHours - $offsetMinutes; + } else { + $expirationDate = $expirationDate + $offsetHours + $offsetMinutes; + } + + # Okay, now we have correct unix timestamp, heh + my $res = $cache->compute ( + 'Holiday', + { expires_at => $expirationDate }, + $drinkCallBack + ); + + if (defined $res && $res ne '') { + return $res; + } else { + return 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.'; + } +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Fisher.pm b/lib/BotLib/Fisher.pm new file mode 100644 index 0000000..1d6a9d8 --- /dev/null +++ b/lib/BotLib/Fisher.pm @@ -0,0 +1,133 @@ +package BotLib::Fisher; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Math::Random::Secure qw (irand); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Fish); + + +sub Fish { + my $name = shift; + + my @artifact = ( + 'семикрылого чешуйчатого пятихуя', + 'разумного конденсатора', + 'сальмонеллу', + 'селёдку', + 'желтоперого тунца', + 'розовую сальмонеллу', + 'голавля', + 'барбуса', + 'окуня', + 'верхоплавку', + 'коричневую форель', + 'полярника', + 'плотву', + 'зубатку', + 'солнечную рыбу', + 'старую шину', + 'скользкую корягу', + 'лампу джина', + 'любовное послание в бутылке', + 'старое бревно', + 'резиновый сапог', + 'труп', + 'Лох-Несское чудовище', + 'старую рыбацкую приманку', + 'кусок Титаника', + 'обломок Атлантиды', + 'кита', + 'кальмара', + 'дельфина', + 'ската', + 'подводную лодку', + 'медузу', + 'морскую звезду', + 'электрического угря', + 'большую белую акулу', + 'аквалангиста', + 'монстра', + 'вируса', + 'сырую пачку сигарет', + 'водоросли', + 'якорь от лодки', + 'водяного', + 'русалку', + 'палтуса', + 'труп собаки по кличке Беня', + 'олигофрена Проню', + 'огеймера Фишкина', + ); + + my @location = ( + 'в поток', + 'в озеро', + 'в реку', + 'в северерный ледовитый океан', + 'в индийский океан', + 'в биде', + 'в детский плавательный бассейн', + 'в туалет', + 'в кучу рвоты', + 'в лужу мочи', + 'в раковину', + 'в слив ванной', + 'в лужу грязи', + 'в ведро воды', + 'в бутылку с водкой', + 'в ванную', + 'в бочку с дождевой водой', + 'в аквариум', + 'в сугроб', + 'в водопад', + 'в чашку кофе', + 'в стакан молока', + 'в черную дыру', + 'дно Удомельского реактора', + 'на Марс', + 'в соседнюю галактуку', + 'к соседу на балкон', + 'далеко-далеко', + 'далеко и надолго', + 'на крышу дома', + ); + + my @material = ( + 'бамбуковую', + 'фиберглассовую', + 'карбоновую', + 'композитную', + ); + + my $find_probability = irand 100; + my $success_probability = irand 100; + my $weight = irand 7000; + + my $phrase = sprintf "Вы забрасываете %s удочку %s.\nВы чувствуете поклевку и начинаете быстро тащить что-то.\n", $material[irand ($#material + 1)], $location[irand ($#location + 1)]; + + if ($find_probability <= 20) { + $phrase .= sprintf 'Черт, твоя рыбка сорвалась, %s! Не беда, может потом повезет?', $name; + return $phrase; + } + + $phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact[irand ($#artifact + 1)], $weight; + + if ($success_probability <= 25) { + $phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name; + } else { + $phrase .= sprintf 'Извини %s, но это не новый рекорд! Однако, хорошая попытка!', $name; + } + + return $phrase; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Fortune.pm b/lib/BotLib/Fortune.pm new file mode 100644 index 0000000..ae6dbb7 --- /dev/null +++ b/lib/BotLib/Fortune.pm @@ -0,0 +1,85 @@ +package BotLib::Fortune; +# Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimiters. + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Carp qw (croak carp); +use File::Path qw (make_path); +use Math::Random::Secure qw (irand); +use MIME::Base64; +use SQLite_File; +use BotLib::Conf qw (LoadConf); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Seed Fortune); + +my $c = LoadConf (); +my $dir = $c->{fortune}->{dir}; +my $srcdir = $c->{fortune}->{srcdir}; + +sub Seed () { + unless (-d $dir) { + make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; + } + + my $backingfile = sprintf '%s/fortune.sqlite', $dir; + + if (-f $backingfile) { + unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR\n"; + } + + tie my @fortune, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR\n"; + opendir (my $srcdirhandle, $srcdir) || croak "Unable to open $srcdir: $OS_ERROR"; + + while (my $fortunefile = readdir $srcdirhandle) { + my $srcfile = sprintf '%s/%s', $srcdir, $fortunefile; + + unless (-f $srcfile) { + next; + } + + if ($fortunefile =~ m/\./) { + next ; + } + + open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR\n"; + # set correct phrase delimiter + local $INPUT_RECORD_SEPARATOR = "\n%\n"; + + while (readline $fh) { + my $phrase = substr $_, 0, -3; + push @fortune, $phrase; + } + + close $fh; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + } + + closedir $srcdirhandle; + untie @fortune; + return; +} + +# just return answer +sub Fortune () { + my $backingfile = sprintf '%s/fortune.sqlite', $dir; + + tie my @array, 'SQLite_File', $backingfile || do { + carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"); + return ''; + }; + + my $phrase = $array[irand ($#array - 1)]; + # decode? + utf8::decode $phrase; + untie @array; + return $phrase; +} + +1; + +# vim: ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Fox.pm b/lib/BotLib/Fox.pm new file mode 100644 index 0000000..246d0dd --- /dev/null +++ b/lib/BotLib/Fox.pm @@ -0,0 +1,54 @@ +package BotLib::Fox; + +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 JSON::XS; +use HTTP::Tiny; + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Fox); + +sub Fox { + my $r; + my $ret = 'Нету лисичек, все разбежались.'; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('https://randomfox.ca/floof/'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $jfox = eval { + decode_json ($r->{content}) + }; + + unless (defined $jfox) { + carp ("[WARN] Unable to decode JSON: $EVAL_ERROR\n"); + } else { + if ($jfox->{image}) { + $jfox->{image} =~ s/\\//xmsg; + $ret = $jfox->{image}; + } + } + } else { + carp (sprintf "[WARN] Server return status %s with message: %s\n", $r->{status}, $r->{reason}); + } + + return $ret; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Friday.pm b/lib/BotLib/Friday.pm new file mode 100644 index 0000000..b4c4b36 --- /dev/null +++ b/lib/BotLib/Friday.pm @@ -0,0 +1,96 @@ +package BotLib::Friday; +# for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Carp qw (croak carp); +use File::Path qw (make_path); +use Math::Random::Secure qw (irand); +use SQLite_File; +use BotLib::Conf qw (LoadConf); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Seed Friday); + +my $c = LoadConf (); +my $dir = $c->{friday}->{dir}; +my $srcfile = $c->{friday}->{src}; +my @dow = qw (monday tuesday wednesday thursday friday saturday sunday); + +sub Seed () { + unless (-d $dir) { + make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; + } + + my $friday; + + for (0..$#dow) { + my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$_]; + + if (-f $backingfile) { + unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR\n"; + } + + tie @{$friday->[$_]}, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR\n"; + } + + open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR\n"; + + while (readline $fh) { + unless (m/ \|\| /xmsg) { + next; + } + + chomp (); + my ($phrase, $days) = split (/ \|\| /); + my @daylist = split (//, $days); + + foreach my $day (@daylist) { + unless (defined $day) { + next ; + } + + unless ($day =~ /^\d$/) { + next ; + } + + if (defined ($phrase) && ($phrase ne '') && ($phrase !~ m/^\s+$/xmsg)) { + push @{$friday->[$day - 1]}, $phrase; + } + } + } + + close $fh; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + + for (0..$#dow) { + untie $friday->[$_]; + } + + return; +} + +# just return answer +sub Friday () { + my $today = (localtime (time))[6] - 1; + my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today]; + + tie my @array, 'SQLite_File', $backingfile || do { + carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"); + return ''; + }; + + my $phrase = $array[irand ($#array - 1)]; + # decode? + utf8::decode $phrase; + untie @array; + return $phrase; +} + +1; + +# vim: ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Image.pm b/lib/BotLib/Image.pm new file mode 100644 index 0000000..2c5af44 --- /dev/null +++ b/lib/BotLib/Image.pm @@ -0,0 +1,70 @@ +package BotLib::Image; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use BotLib::Image::Flickr qw (FlickrByTags); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Rabbit Owl Frog Horse Snail); + +sub Rabbit { + # rabbit, but bunny + my $url = FlickrByTags ('animal,bunny'); + + if (defined $url) { + return $url; + } else { + return 'Нету кроликов, все разбежались.'; + } +} + +sub Owl { + my $url = FlickrByTags ('bird,owl'); + + if (defined $url) { + return $url; + } else { + return 'Нету сов, все разлетелись.'; + } +} + +sub Frog { + # unable to find any one-line ascii art for frog :( + my $url = FlickrByTags ('frog,toad,amphibian'); + + if (defined $url) { + return $url; + } else { + return 'Нету лягушек, все свалили.'; + } +} + +sub Horse { + # unable to find any one-line ascii art for frog :( + my $url = FlickrByTags ('horse,equine,mammal'); + + if (defined $url) { + return $url; + } else { + return 'Нету коняшек, все разбежались.'; + } +} + +sub Snail { + # unable to find any one-line ascii art for frog :( + my $url = FlickrByTags ('snail,slug'); + + if (defined $url) { + return $url; + } else { + return 'Нету улиток, все расползлись.'; + } +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Image/Flickr.pm b/lib/BotLib/Image/Flickr.pm new file mode 100644 index 0000000..5421a8c --- /dev/null +++ b/lib/BotLib/Image/Flickr.pm @@ -0,0 +1,639 @@ +package BotLib::Image::Flickr; + +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 Digest::HMAC_SHA1 qw (hmac_sha1); +use File::Path qw (make_path); +use JSON::XS; +use HTTP::Tiny; +use Math::Random::Secure qw (irand); +use MIME::Base64; +use SQLite_File; +use URI::Encode::XS qw (uri_encode); + +use BotLib::Conf qw (LoadConf); +use BotLib::Util qw (urlencode); + +use Data::Dumper; + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (FlickrInit FlickrByTags FlickrByText FlickrTestLogin); + +my $c = LoadConf (); +my $dir = $c->{image}->{dir}; + +my $flickr_consumer_key = $c->{image}->{flickr}->{consumer_key}; +my $flickr_consumer_secret = $c->{image}->{flickr}->{consumer_secret}; +my $flickr_verifier = $c->{image}->{flickr}->{verifier}; +my $flickr_request_token_url = 'https://www.flickr.com/services/oauth/request_token'; +my $flickr_authorization_url = 'https://www.flickr.com/services/oauth/authorize'; +my $flickr_access_token_url = 'https://www.flickr.com/services/oauth/access_token'; +my $flickr_callback_url = 'http://www.example.com'; +my $flickr_api_url = 'https://www.flickr.com/services/rest/'; + +sub mknonce { + # make random number, 8 symbols in length + my $nonce = sprintf '%08d', irand (99999999); + return $nonce; +} + +sub flickrSignReq { + my %p = @_; + my $string; + my $hmac; + + if ($p{type} eq 'request_token') { + my @parameters; + delete $p{type}; + push @parameters, 'oauth_signature_method=HMAC-SHA1'; + push @parameters, 'oauth_version=1.0'; + push @parameters, sprintf 'oauth_callback=%s', uri_encode ($flickr_callback_url); + push @parameters, sprintf 'oauth_consumer_key=%s', $flickr_consumer_key; + + foreach my $param (keys %p) { + push @parameters, sprintf ('%s=%s', $param, $p{$param}); + } + + $string = sprintf 'GET&%s&', uri_encode ($flickr_request_token_url); + $string .= uri_encode (join '&', sort (@parameters)); + # Thanks to twitter api dev portal, they explain this particular case: while we requesting this token + # we do not yet know access_token secret, so we just omit it in this signature + # https://developer.twitter.com/en/docs/authentication/oauth-1-0a/creating-a-signature + $hmac = Digest::HMAC_SHA1->new (sprintf '%s&', uri_encode ($flickr_consumer_secret)); + } elsif ($p{type} eq 'access_token') { + my @parameters; + my $flickr_request_token_secret = $p{oauth_token_secret}; + delete $p{oauth_token_secret}; + delete $p{type}; + push @parameters, 'oauth_signature_method=HMAC-SHA1'; + push @parameters, 'oauth_version=1.0'; + push @parameters, sprintf 'oauth_consumer_key=%s', $flickr_consumer_key; + + foreach my $param (keys %p) { + push @parameters, sprintf ('%s=%s', $param, $p{$param}); + } + + $string = sprintf 'GET&%s&', uri_encode ($flickr_access_token_url); + $string .= uri_encode (join '&', sort (@parameters)); + $hmac = Digest::HMAC_SHA1->new (sprintf '%s&%s', uri_encode ($flickr_consumer_secret), uri_encode ($flickr_request_token_secret)); + } elsif ($p{type} eq 'test_login' || $p{type} eq 'search_text' || $p{type} eq 'search_tags') { + my @parameters; + my $flickr_request_token_secret = $p{oauth_token_secret}; + delete $p{oauth_token_secret}; + delete $p{type}; + + foreach my $param (keys %p) { + push @parameters, sprintf ('%s=%s', $param, $p{$param}); + } + + $string = sprintf 'GET&%s&', uri_encode ($flickr_api_url); + $string .= uri_encode (join '&', sort (@parameters)); + $hmac = Digest::HMAC_SHA1->new (sprintf '%s&%s', uri_encode ($flickr_consumer_secret), uri_encode ($flickr_request_token_secret)); + } + + $hmac->add ($string); + return encode_base64 ($hmac->digest, ''); +} + +sub flickrRequestToken { + my $oauth_timestamp = time (); + my $oauth_nonce = mknonce (); + + my $oauth_signature = flickrSignReq ( + type => 'request_token', + oauth_timestamp => $oauth_timestamp, + oauth_nonce => $oauth_nonce + ); + + my $url = $flickr_request_token_url . sprintf ( + '?oauth_nonce=%s&oauth_timestamp=%s&oauth_consumer_key=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&&oauth_signature=%s&oauth_callback=%s', + $oauth_nonce, + $oauth_timestamp, + $flickr_consumer_key, + uri_encode ($oauth_signature), + uri_encode ($flickr_callback_url) + ); + + my $http = HTTP::Tiny->new (timeout => 5); + my $r = $http->get ($url); + my %params; + + if ($r->{success}) { + # they ignore format=json, so... + %params = map {split /=/} split /&/, $r->{content}; + } else { + say "Something bad returns from flickr api: $r->{status} $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls) + } + + return %params; +} + +sub flickrAccessToken { + my $flickr_request_token = shift; + my $flickr_request_token_secret = shift; + my $flickr_verifier = shift; ## no critic (Variables::ProhibitReusedNames) + + my $oauth_timestamp = time (); + my $oauth_nonce = mknonce (); + + my $oauth_signature = flickrSignReq ( + type => 'access_token', + oauth_timestamp => $oauth_timestamp, + oauth_nonce => $oauth_nonce, + oauth_token => $flickr_request_token, + oauth_token_secret => $flickr_request_token_secret, + oauth_verifier => $flickr_verifier + ); + + my $url = $flickr_access_token_url . sprintf ( + '?oauth_nonce=%s&oauth_timestamp=%s&oauth_verifier=%s&oauth_consumer_key=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s', + $oauth_nonce, + $oauth_timestamp, + $flickr_verifier, + $flickr_consumer_key, + $flickr_request_token, + uri_encode ($oauth_signature) + ); + + my $http = HTTP::Tiny->new (timeout => 5); + my $r = $http->get ($url); + my %params; + + if ($r->{success}) { + # they ignore format=json + %params = map {split /=/} split /&/, $r->{content}; + } else { + say "Something bad returns from flickr api: $r->{status} $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls) + } + + return %params; +} + +sub flickrAuthorization { + my $flickr_request_token = shift; + + my $url = $flickr_authorization_url . sprintf ( + '?oauth_token=%s&perms=read', + $flickr_request_token, + ); + + my $http = HTTP::Tiny->new (timeout => 5); + my $r = $http->get ($url); + + if ($r->{success}) { + return $r->{url}; + } else { + say "Something went wrong: $r->{status} $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls) + return; + } +} + +sub flickrTestLogin { + my $flickr_access_token = shift; + my $flickr_access_token_secret = shift; + + my $oauth_timestamp = time (); + my $oauth_nonce = mknonce (); + + my $oauth_signature = flickrSignReq ( + nojsoncallback => 1, + oauth_nonce => $oauth_nonce, + format => 'json', + oauth_consumer_key => $flickr_consumer_key, + oauth_timestamp => $oauth_timestamp, + type => 'test_login', + method => 'flickr.test.login', + oauth_token => $flickr_access_token, + oauth_token_secret => $flickr_access_token_secret, + oauth_signature_method => 'HMAC-SHA1', + oauth_version => '1.0' + ); + + my $url = $flickr_api_url . sprintf ( + '?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.test.login', + $oauth_nonce, + $flickr_consumer_key, + $oauth_timestamp, + $flickr_access_token, + uri_encode ($oauth_signature) + ); + + my $http = HTTP::Tiny->new (timeout => 5); + my $r = $http->get ($url); + + if ($r->{success}) { + my $response = eval { + my $j = JSON::XS->new->utf8->relaxed; + return $j->decode ($r->{content}); + }; + + if (defined $response) { + say Dumper $response; ## no critic (InputOutput::RequireCheckedSyscalls) + return 1; + } else { + say "Flickr api returns incorrect json: $r->{content}"; ## no critic (InputOutput::RequireCheckedSyscalls) + return 0; + } + } else { + say "HTTP status code not 200: $r->{status}, $r>{contenr}"; ## no critic (InputOutput::RequireCheckedSyscalls) + return 0; + } +} + +sub flickrSearchByText { + my $flickr_access_token = shift; + my $flickr_access_token_secret = shift; + my $text = shift; + + my $oauth_timestamp = time (); + my $oauth_nonce = mknonce (); + + my $oauth_signature = flickrSignReq ( + nojsoncallback => 1, + oauth_nonce => $oauth_nonce, + format => 'json', + oauth_consumer_key => $flickr_consumer_key, + oauth_timestamp => $oauth_timestamp, + type => 'search_text', + content_type => 1, + media => 'photos', + method => 'flickr.photos.search', + text => $text, + per_page => 1, + oauth_token => $flickr_access_token, + oauth_token_secret => $flickr_access_token_secret, + oauth_signature_method => 'HMAC-SHA1', + oauth_version => '1.0' + ); + + my $url = $flickr_api_url . sprintf ( + '?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=1&text=%s', + $oauth_nonce, + $flickr_consumer_key, + $oauth_timestamp, + $flickr_access_token, + uri_encode ($oauth_signature), + uri_encode ($text) + ); + + my $http = HTTP::Tiny->new (timeout => 5); + my $r = $http->get ($url); + + if ($r->{success}) { + my $response = eval { + my $j = JSON::XS->new->utf8->relaxed; + return $j->decode ($r->{content}); + }; + + if (defined $response) { + # lets make another query, this time with random picture + my $page = irand (int $response->{photos}->{total} / 500); + $oauth_timestamp = time (); + $oauth_nonce = mknonce (); + $oauth_signature = flickrSignReq ( + nojsoncallback => 1, + oauth_nonce => $oauth_nonce, + format => 'json', + oauth_consumer_key => $flickr_consumer_key, + oauth_timestamp => $oauth_timestamp, + type => 'search_text', + content_type => 1, + media => 'photos', + method => 'flickr.photos.search', + text => $text, + page => $page, + per_page => 500, + oauth_token => $flickr_access_token, + oauth_token_secret => $flickr_access_token_secret, + oauth_signature_method => 'HMAC-SHA1', + oauth_version => '1.0' + ); + + $url = $flickr_api_url . sprintf ( + '?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=500&page=%d&text=%s', + $oauth_nonce, + $flickr_consumer_key, + $oauth_timestamp, + $flickr_access_token, + uri_encode ($oauth_signature), + $page, + uri_encode ($text) + ); + + $http = HTTP::Tiny->new (timeout => 5); + $r = $http->get ($url); + + if ($r->{success}) { + $response = eval { + my $j = JSON::XS->new->utf8->relaxed; + return $j->decode ($r->{content}); + }; + + if (defined $response) { + return $response; + } else { + carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n"); + return undef; + } + } else { + carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n"); + return undef; + } + } else { + carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n"); + return undef; + } + } else { + carp ("[WARN] HTTP status code not 200: $r->{status}, $r->{content}\n"); + return undef; + } +} + +sub flickrSearchByTags { + my $flickr_access_token = shift; + my $flickr_access_token_secret = shift; + my $tags = shift; + + my $oauth_timestamp = time (); + my $oauth_nonce = mknonce (); + + my $oauth_signature = flickrSignReq ( + nojsoncallback => 1, + oauth_nonce => $oauth_nonce, + format => 'json', + oauth_consumer_key => $flickr_consumer_key, + oauth_timestamp => $oauth_timestamp, + type => 'search_tags', + content_type => 1, + media => 'photos', + method => 'flickr.photos.search', + tags => $tags, + per_page => 1, + oauth_token => $flickr_access_token, + oauth_token_secret => $flickr_access_token_secret, + oauth_signature_method => 'HMAC-SHA1', + oauth_version => '1.0' + ); + + my $url = $flickr_api_url . sprintf ( + '?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=1&tags=%s&tag_mode=all', + $oauth_nonce, + $flickr_consumer_key, + $oauth_timestamp, + $flickr_access_token, + uri_encode ($oauth_signature), + uri_encode ($tags) + ); + + my $http = HTTP::Tiny->new (timeout => 5); + my $r = $http->get ($url); + + if ($r->{success}) { + my $response = eval { + my $j = JSON::XS->new->utf8->relaxed; + return $j->decode ($r->{content}); + }; + + if (defined $response) { + # lets make another query, this time with random picture + my $page = irand int ($response->{photos}->{total} / 500); + $oauth_timestamp = time (); + $oauth_nonce = mknonce (); + $oauth_signature = flickrSignReq ( + nojsoncallback => 1, + oauth_nonce => $oauth_nonce, + format => 'json', + oauth_consumer_key => $flickr_consumer_key, + oauth_timestamp => $oauth_timestamp, + type => 'search_text', + content_type => 1, + media => 'photos', + method => 'flickr.photos.search', + tags => $tags, + page => $page, + per_page => 500, + oauth_token => $flickr_access_token, + oauth_token_secret => $flickr_access_token_secret, + oauth_signature_method => 'HMAC-SHA1', + oauth_version => '1.0' + ); + + $url = $flickr_api_url . sprintf ( + '?nojsoncallback=1&oauth_nonce=%s&format=json&oauth_consumer_key=%s&oauth_timestamp=%s&oauth_signature_method=HMAC-SHA1&oauth_version=1.0&oauth_token=%s&oauth_signature=%s&method=flickr.photos.search&content_type=1&media=photos&per_page=500&page=%d&tags=%s&tag_mode=all', + $oauth_nonce, + $flickr_consumer_key, + $oauth_timestamp, + $flickr_access_token, + uri_encode ($oauth_signature), + $page, + uri_encode ($tags) + ); + + $http = HTTP::Tiny->new (timeout => 5); + $r = $http->get ($url); + + if ($r->{success}) { + $response = eval { + my $j = JSON::XS->new->utf8->relaxed; + return $j->decode ($r->{content}); + }; + + if (defined $response) { + return $response; + } else { + carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n"); + return undef; + } + } else { + carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n"); + return undef; + } + } else { + carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n"); + return undef; + } + } else { + carp ("[WARN] HTTP status code not 200: $r->{status}, $r>{content}\n"); + return undef; + } +} + +sub FlickrInit { + my $backingfile = sprintf '%s/secrets.sqlite', $dir; + + unless (-d $dir) { + make_path ($dir) or do { + say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) + return 0; + }; + } + + tie my %secret, 'SQLite_File', $backingfile || do { + say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) + return 0; + }; + + if (defined $flickr_verifier && $flickr_verifier) { + my $flickr_request_token = $secret{flickr_request_token}; + my $flickr_request_token_secret = $secret{flickr_request_token_secret}; + + unless (defined $flickr_request_token || defined $flickr_request_token_secret) { + say "Looks like there is no request token or request token secret in $backingfile"; ## no critic (InputOutput::RequireCheckedSyscalls) + say 'Please remove verifier settings from config.json and run this script again'; ## no critic (InputOutput::RequireCheckedSyscalls) + untie %secret; + return 0; + } + + my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier); + + if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) { + $secret{flickr_access_token} = $accessToken{oauth_token}; + $secret{flickr_access_token_secret} = $accessToken{oauth_token_secret}; + + say sprintf ( ## no critic (InputOutput::RequireCheckedSyscalls) + 'Access token (%s) and access token secret (%s) are in %s', + $accessToken{oauth_token}, + $accessToken{oauth_token_secret}, + $backingfile + ); + + untie %secret; + return 1; + } + } else { + my %req = flickrRequestToken (); + if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) { + $secret{flickr_request_token} = $req{oauth_token}; + $secret{flickr_request_token_secret} = $req{oauth_token_secret}; + my $confirm_url = flickrAuthorization ($req{oauth_token}); + + if (defined $confirm_url) { + say "Please open this url in your browser and grant access for this app:\n$confirm_url"; ## no critic (InputOutput::RequireCheckedSyscalls) + say 'Do not forget to put oauth_verifier to config.json file and re-run this script to get access token'; ## no critic (InputOutput::RequireCheckedSyscalls) + say 'Note that you should be logged off from flickr account.'; ## no critic (InputOutput::RequireCheckedSyscalls) + untie %secret; + return 1; + } + } + } + + untie %secret; + return 0; +} + +sub FlickrTestLogin { + my $text = shift; + my $backingfile = sprintf '%s/secrets.sqlite', $dir; + + unless (-d $dir) { + make_path ($dir) or do { + say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) + return 0; + }; + } + + tie my %secret, 'SQLite_File', $backingfile || do { + say "Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) + return 0; + }; + + my $flickr_access_token = $secret{flickr_access_token}; + my $flickr_access_token_secret = $secret{flickr_access_token_secret}; + untie %secret; + + if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) { + return 1; + } else { + return 0; + } +} + +sub FlickrByTags { + my $text = shift; + my $backingfile = sprintf '%s/secrets.sqlite', $dir; + + unless (-d $dir) { + make_path ($dir) or do { + carp ("[ERROR] Unable to create $dir: $OS_ERROR\n"); + return 0; + }; + } + + tie my %secret, 'SQLite_File', $backingfile || do { + carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"); + return 0; + }; + + my $flickr_access_token = $secret{flickr_access_token}; + my $flickr_access_token_secret = $secret{flickr_access_token_secret}; + untie %secret; + + # NB: I honestly query random page (among number of pages) of results from api, but always got first page, + # no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate + # this bug via query 500 results per page, then we can select random result in this heap. But anyway, let's + # make this thing future proof and leave randomizer in page select. + my $result = flickrSearchByTags ($flickr_access_token, $flickr_access_token_secret, $text); + + if ($result) { + if (defined ($result->{photos}) && defined ($result->{photos}->{photo})) { + my $item = irand int @{$result->{photos}->{photo}}; + $item = ${$result->{photos}->{photo}}[$item]; + $item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret}; + return $item; + } else { + carp ("[NOTICE] Flickr api returns empty search result list\n"); + return; + } + } else { + return; + } +} + +sub FlickrByText { + my $text = shift; + my $backingfile = sprintf '%s/secrets.sqlite', $dir; + + unless (-d $dir) { + make_path ($dir) or do { + carp ("[ERROR] Unable to create $dir: $OS_ERROR\n"); + return 0; + }; + } + + tie my %secret, 'SQLite_File', $backingfile || do { + carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"); + return 0; + }; + + my $flickr_access_token = $secret{flickr_access_token}; + my $flickr_access_token_secret = $secret{flickr_access_token_secret}; + untie %secret; + + # NB: I honestly query random page (among number of pages) of results from api, but always got first page, + # no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate + # this bug via query 500 results per page, then we can select random result in this heap. But anyway, let's + # make this thing future proof and leave randomizer in page select. + my $result = flickrSearchByText ($flickr_access_token, $flickr_access_token_secret, $text); + + if ($result) { + if (defined ($result->{photos}) && defined ($result->{photos}->{photo})) { + my $item = irand (int (@{$result->{photos}->{photo}})); + $item = ${$result->{photos}->{photo}}[$item]; + $item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret}; + return $item; + } else { + carp ("[NOTICE] Flickr api returns empty search result list\n"); + return; + } + } else { + return; + } +} + +1; diff --git a/lib/BotLib/Karma.pm b/lib/BotLib/Karma.pm new file mode 100644 index 0000000..bd2032e --- /dev/null +++ b/lib/BotLib/Karma.pm @@ -0,0 +1,125 @@ +package BotLib::Karma; + +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 DB_File; +use File::Path qw (make_path); +use BotLib::Conf qw (LoadConf); +use BotLib::Util qw (utf2sha1 trim); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (KarmaSet KarmaGet); + +my $c = LoadConf (); +my $karmadir = $c->{karma}->{dir}; +my $max = 5; + +# swallow phrase and return answer +sub KarmaSet (@) { + my $chatid = shift; + my $phrase = shift; + my $action = shift; + $phrase = trim $phrase; + my $score = 0; + # sha1* does not understand utf8, so explicitly construct string cost of decimal numbers only + my $karmafile = utf2sha1 $chatid; + $karmafile =~ s/\//-/xmsg; + $karmafile = sprintf '%s/%s.db', $karmadir, $karmafile; + + unless (-d $karmadir) { + make_path ($karmadir) or do { + carp ("[ERROR] Unable to create $karmadir: $OS_ERROR\n"); + return sprintf 'Карма %s составляет 0', $phrase; + }; + } + + # init hash, store phrase and score + tie my %karma, 'DB_File', $karmafile || do { + carp ("[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR\n"); + return sprintf 'Карма %s составляет 0', $phrase; + }; + + # bdb does not understand utf8, so tied hash too, we do not want store original phrase anyway + my $sha1_phrase = utf2sha1 $phrase; + + if (defined $karma{$sha1_phrase}) { + if ($action eq '++') { + $score = $karma{$sha1_phrase} + 1; + $karma{$sha1_phrase} = $score; + } else { + $score = $karma{$sha1_phrase} - 1; + $karma{$sha1_phrase} = $score; + } + } else { + if ($action eq '++') { + $karma{$sha1_phrase} = 1; + $score = 1; + } else { + $karma{$sha1_phrase} = -1; + $score = -1; + } + } + + untie %karma; + + if ($score < -1 && (($score % (0 - $max)) + 1) == 0) { + if ($phrase eq '') { + return sprintf 'Зарегистрировано пробитие дна, карма пустоты составляет %d', $score; + } else { + return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score; + } + } else { + if ($phrase eq '') { + return sprintf 'Карма пустоты составляет %d', $score; + } else { + return sprintf 'Карма %s составляет %d', $phrase, $score; + } + } +} + +# just return answer +sub KarmaGet (@) { + my $chatid = shift; + my $phrase = shift; + $phrase = trim $phrase; + my $karmafile = utf2sha1 $chatid; + $karmafile =~ s/\//-/xmsg; + $karmafile = sprintf '%s/%s.db', $karmadir, $karmafile; + + unless (-d $karmadir) { + make_path ($karmadir) or do { + carp ("Unable to create $karmadir: $OS_ERROR\n"); + return sprintf 'Карма %s составляет 0', $phrase; + }; + } + + # init hash, store phrase and score + tie my %karma, 'DB_File', $karmafile || do { + carp ("[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR\n"); + return sprintf 'Карма %s составляет 0', $phrase; + }; + + my $sha1_phrase = utf2sha1 $phrase; + my $score = $karma{$sha1_phrase}; + untie %karma; + + unless (defined $score) { + $score = 0; + } + + if ($phrase eq '') { + return sprintf 'Карма пустоты составляет %d', $score; + } else { + return sprintf 'Карма %s составляет %d', $phrase, $score; + } +} + +1; + +# vim: ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Kitty.pm b/lib/BotLib/Kitty.pm new file mode 100644 index 0000000..09b1801 --- /dev/null +++ b/lib/BotLib/Kitty.pm @@ -0,0 +1,53 @@ +package BotLib::Kitty; + +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 JSON::XS; +use HTTP::Tiny; + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Kitty); + +sub Kitty { + my $r; + my $ret = 'Нету кошечек, все разбежались.'; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('https://api.thecatapi.com/v1/images/search'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $jcat = eval { + decode_json ($r->{content}) + }; + + unless (defined $jcat) { + carp ("[ERROR] Unable to decode JSON: $EVAL_ERROR\n"); + } else { + if ($jcat->[0]->{url}) { + $ret = $jcat->[0]->{url}; + } + } + } else { + carp (sprintf "Server return status %s with message: %s\n", $r->{status}, $r->{reason}); + } + + return $ret; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Lat.pm b/lib/BotLib/Lat.pm new file mode 100644 index 0000000..d1d34ed --- /dev/null +++ b/lib/BotLib/Lat.pm @@ -0,0 +1,73 @@ +package BotLib::Lat; +# famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений + +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 File::Basename qw (dirname); +use File::Path qw (make_path); +use Hailo; +use BotLib::Conf qw (LoadConf); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Train Lat); + +my $c = LoadConf (); +my $brain = $c->{lat}->{brain}; +my $srcfile = $c->{lat}->{src}; + +sub Train () { + my $braindir = dirname $brain; + + unless (-d $braindir) { + make_path ($braindir) or do { + carp "Unable to create $braindir: $OS_ERROR"; + exit 1; + }; + } + + my $lat = Hailo->new ( + brain => $brain, + # in our case mean amount of words in phase is 3 + order => 2 + ); + + $lat->train ($srcfile); + my ($tokens, $expressions) = ($lat->stats ())[0,1]; + printf "Total tokens: %s\nTotal expressions: %s\n", $tokens, $expressions; + $lat->save (); + return; +} + +# just return answer +sub Lat () { + my $braindir = dirname $brain; + + unless (-d $braindir) { + carp ("[ERROR] No lat module data: $braindir is absent! Train lat first.\n"); + return ''; + } + + unless (-f $brain) { + carp ("[ERROR] No lat module data: $brain is absent! Train lat first.\n"); + return ''; + } + + my $lat = Hailo->new ( + brain => $brain, + # in our case mean amount of words in phase is 3 + order => 2, + save_on_exit => 0 + ); + + return $lat->reply (); +} + +1; + +# vim: ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Monkeyuser.pm b/lib/BotLib/Monkeyuser.pm new file mode 100644 index 0000000..d2878bf --- /dev/null +++ b/lib/BotLib/Monkeyuser.pm @@ -0,0 +1,62 @@ +package BotLib::Monkeyuser; + +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 HTTP::Tiny; +use HTML::TokeParser; +use Math::Random::Secure qw (irand); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Monkeyuser); + +sub Monkeyuser { + my $r; + my $ret = 'Нету Monkey User-ов, они все спрятались.'; + my @link; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('https://www.monkeyuser.com/toc/'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $p = HTML::TokeParser->new(\$r->{content}); + my @a; + + do { + $#a = -1; + @a = $p->get_tag ('a'); ## no critic (Variables::RequireLocalizedPunctuationVars) + + if (defined $a[0][1]->{class} && $a[0][1]->{class} eq 'lazyload small-image') { + if (defined $a[0][1]->{'data-src'} && ($a[0][1]->{'data-src'} !~ /adlitteram/)) { + push @link, $a[0][1]->{'data-src'}; + } + } + + } while ($#{$a[0]} > 1); + + if ($#link > 0) { + $ret = sprintf 'https://www.monkeyuser.com%s', $link[irand (1 + $#link)]; + } + } else { + carp (sprintf "[WARN] Monkeyuser server return status %s with message: %s\n", $r->{status}, $r->{reason}); + } + + return $ret; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Util.pm b/lib/BotLib/Util.pm new file mode 100644 index 0000000..70a6a36 --- /dev/null +++ b/lib/BotLib/Util.pm @@ -0,0 +1,116 @@ +package BotLib::Util; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Carp qw (cluck); +use Digest::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; + + unless (defined $str) { + cluck '[ERROR] Str is undefined'; + return ''; + } + + 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; + + unless (defined $str) { + cluck '[ERROR] Str is undefined'; + return ''; + } + + my $urlobj = url $str; + return $urlobj->as_string; +} + +sub fmatch { + my $srcphrase = shift; + my $answer = shift; + + if ((! defined $srcphrase) || (! defined $answer)) { + if (defined $srcphrase) { + cluck '[ERROR] Answer undefined'; + } elsif (defined $answer) { + cluck '[ERROR] Srcphrase undefined'; + } else { + cluck '[ERROR] Both srcphrase and answer are undefined'; + } + + return 0; + } + + 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; + + unless (defined $string) { + cluck '[ERROR] String is undefined'; + return sha1_base64 ''; + } + + if ($string eq '') { + return encode_base64 ''; + } + + my $bytes = encode_utf8 $string; + return encode_base64 $bytes; +} + +sub utf2sha1 { + my $string = shift; + + unless (defined $string) { + cluck '[ERROR] String is undefined'; + return sha1_base64 ''; + } + + 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: diff --git a/lib/BotLib/Weather.pm b/lib/BotLib/Weather.pm new file mode 100644 index 0000000..a92edf8 --- /dev/null +++ b/lib/BotLib/Weather.pm @@ -0,0 +1,176 @@ +package BotLib::Weather; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Carp qw (carp cluck); +use CHI; +use CHI::Driver::BerkeleyDB; +use HTTP::Tiny; +use JSON::XS; +use BotLib::Conf qw (LoadConf); +use BotLib::Util qw (trim urlencode); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Weather); + +my $c = LoadConf (); + +sub Weather { + my $city = shift; + $city = trim $city; + + return 'Мне нужно ИМЯ города.' if ($city eq ''); + return 'Длинновато для названия города.' if (length ($city) > 80); + + $city = ucfirst $city; + + my $weatherCallBack = sub { + my $appid = $c->{openweathermap}->{appid}; + + unless (defined $appid) { + carp ("[WARN] No appid specified for openweathermap\n"); + return undef; + } + + my $fc; + my $w; + my $r; + + # try 3 times and giveup + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', urlencode ($city), $appid)); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + # all 3 times can give error, so check it here + if ($r->{success}) { + $fc = eval { + decode_json ($r->{content}); + }; + + unless (defined $fc) { + carp ("[WARN] openweathermap returns corrupted json: $EVAL_ERROR\n"); + return undef; + }; + } else { + carp (sprintf "Server return status %s with message: %s\n", $r->{status}, $r->{reason}); + return undef; + } + + # TODO: check all of this for existence + $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; + }; + + my $cache = CHI->new ( + driver => 'BerkeleyDB', + root_dir => $c->{cachedir}, + namespace => __PACKAGE__ + ); + + my $w = $cache->compute ( + $city, + '3 hours', + $weatherCallBack + ); + + 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; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/BotLib/Xkcd.pm b/lib/BotLib/Xkcd.pm new file mode 100644 index 0000000..f6cf51d --- /dev/null +++ b/lib/BotLib/Xkcd.pm @@ -0,0 +1,42 @@ +package BotLib::Xkcd; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use HTTP::Tiny; + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (Xkcd); + +sub Xkcd { + my $http = HTTP::Tiny->new (timeout => 5, max_redirect => 0); + my $location; + my $status = 400; + my $c = 0; + + do { + my $r = $http->get ('https://xkcd.ru/random/'); + + if (defined $r->{headers} && defined $r->{headers}->{location} && $r->{headers}->{location} ne '') { + $location = substr ($r->{headers}->{location}, 1, -1); + $location = sprintf 'https://xkcd.ru/i/%s_v1.png', $location; + $r = $http->head ($location); + } + + $c++; + $status = $r->{status}; + } while ($c < 3 || $status >= 404); + + if ($status == 200) { + return $location; + } + + return 'Комикс-стрип нарисовать не так-то просто :('; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/IRCBot.pm b/lib/IRCBot.pm new file mode 100644 index 0000000..b43997e --- /dev/null +++ b/lib/IRCBot.pm @@ -0,0 +1,58 @@ +package IRCBot; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Bot::IRC; +use BotLib::Conf qw (LoadConf); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (RunIRCBot); + +my $c = LoadConf (); + + +sub RunIRCBot { + my $c = LoadConf (); + + my $bot = Bot::IRC->new ( + spawn => 2, + daemon => { + name => 'aleesa-irc-bot', + lsb_sdesc => 'Aleesa IRC Bot', + pid_file => $c->{pid}, + stderr_file => $c->{log}, + stdout_file => $c->{debug_log}, + }, + connect => { + server => $c->{server}, + port => $c->{port}, + nick => $c->{nick}, + name => 'Aleesa IRC Bot', + ssl => $c->{ssl}, + ipv6 => 0, + }, + ); + + $bot->load ('OnMessage'); # our main plugin that handles all the incomming messages, mostly + $bot->helps( + about => 'I am just another chatty bot.', + ); + + # finally, run bot + if (defined $c->{'connect_cmd'} && $c->{'connect_cmd'} ne '') { + my @connect_cmd = map {chomp; $_} split (/\n/, $c->{'connect_cmd'}); + $bot->run (@connect_cmd); + } else { + $bot->run; + } +} + + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: