0

Initial commit

This commit is contained in:
eleksir
2021-08-01 00:09:02 +03:00
committed by Sergei Fedosov
commit 2f3e3f764e
38 changed files with 6567 additions and 0 deletions

16
.gitignore vendored Normal file
View File

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

100
.perlcriticrc Normal file
View File

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

127
LICENSE Normal file
View File

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

41
README.md Normal file
View File

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

89
bin/aleesa-irc-bot Executable file
View File

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

29
bin/flickr_init.pl Normal file
View File

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

28
bin/fortune_seed.pl Normal file
View File

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

27
bin/friday_seed.pl Normal file
View File

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

26
bin/train_lat.pl Normal file
View File

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

5
bootstrap.sh Normal file
View File

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

36
confcheck.pl Executable file
View File

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

25
cpanfile Normal file
View File

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

521
data/fortune_src/citates Normal file
View File

@@ -0,0 +1,521 @@
Что сказал Берлиоз своей музыкой? - ничего; но как потрясающе он это
сказал.
-- Джеймс Гиббонз Хьюнекер
%
Музыка будет по-немецки, вы не поймете.
-- Оскар Уайльд
%
Четвертый раз смотрю этот фильм и должна вам сказать, что сегодня актеры
играли как никогда.
-- Фаина Раневская
%
Продолжительность фильма определяется выносливостью мочевого пузыря
обычного зрителя.
-- Альфред Хичкок
%
А что, если наша Земля - ад какой-нибудь другой планеты?
-- Олдос Хаксли
%
Если видишь женщину голой достаточно долго, опять начинаешь обращать
внимание на ее лицо.
-- Генри Миллер
%
Самое главное - выглядеть совершенно естественно; но для этого нужно очень
много косметики.
-- Кельвин Кляйн
%
Любовь - лучшая косметика. Но косметику купить легче.
-- Ив Сен-Лоран
%
Людей без лишнего веса больше всего на кладбище.
-- Биверли Силлз
%
Лучше быть молодым навозным жуков, чем старой райской птицей.
-- Марк Твен
%
К старости недостатки ума становятся все заметнее, как и недостатки
внешности.
-- Франсуа Ларошфуко
%
Лучше быть старой, чем мертвой.
-- Бриджит Бардо
%
Вечеринка с коктейлями: место, где можно встретить людей, которые пьют так
много, что вы не можете вспомнить их имена.
-- Космо Сардо
%
Средство от похмелья: выжать сок из двух бутылок виски...
-- Эдди Кондон
%
Дважды два уже четыре, а будет еще лучше.
-- Хенрик Ягодзинский
%
Я сидел на диете 14 дней и потерял всего две недели.
-- Тоти Филдс
%
В жизни можно полагаться только на себя самого. Да и то не советую!
-- Тристан Бернар
%
Источник нашей мудрости - наш опыт. Источник нашего опыта - наша глупость.
-- Саша Гитри
%
Уходя на тот свет, не забудь выключить этот.
-- Виктор Коваль
%
Я не верю ни единому слову из того, что вы говорите... или я вам.
-- Оскар Уайльд
%
Я думаю, мы должны говорить правду или хотя бы говорить то, что мы думаем.
-- Юрий Лужков
%
Нельзя иметь все. Куда вы это положите?
-- Стивен Райт
%
Сначала забываешь имена, потом забываешь лица, потом забываешь застегивать
ширинку, потом забываешь расстегивать ширинку.
-- Лео Розенберг
%
Время - лучший учитель, но, к сожалению, оно убивает своих учеников.
-- Гектор Берлиоз
%
Прошлое - чужая страна, там все по-другому.
-- Лесли Хартли
%
Помните о бедняках - это не требует никаких расходов.
-- Генри Уиллер Шоу
%
Я люблю своих детей, но некоторые мне не нравятся.
-- Лилиан Картер, мать президента США Д.Картера
%
Дружба - это когда можно ни с того ни с сего приехать к человеку
и поселиться у него.
-- Давид Самойлов
%
Врагов я забрасываю цветами - в гробу!
-- Сальвадор Дали
%
Я не боюсь умереть. Я просто не хочу при этом присутствовать.
-- Вуди Аллен
%
Какой замечательный некролог! С таким бы жить и жить!
-- М.Генин
%
Твои шансы выиграть в лотерею возрастут, если ты купишь билет.
-- Уинстон Грум из "Правил Фореста Гампа"
%
Пока вы ищете, кого бы стоило полюбить, вам нужен кто-то, кто любит вас.
-- Шейла Делейни
%
Если двое любят друг друга, это не может счастливо кончиться.
-- Э.Хемингуэй
%
Я порвала с ним через три года. Это была типичная любовь-ненависть. Мы оба
любили его и ненавидели меня.
-- Кэрол Зискинд
%
В тех кругах, в которых я вращаюсь, переспать с женщиной - недостаточный
повод для того, чтобы быть ей представленным.
-- Вирджиния Маклауд
%
Она говорила на восемнадцати языках и ни на одном из них не умела сказать
"нет".
-- Дороти Паркер
%
Помни: в пяти случаях из шести свет в конце туннеля - это свет
надвигающегося поезда.
-- Пол Диксон
%
Все соседи плохи, но верхние хуже нижних.
-- Константин Мелихан
%
Америка - единственный матриархат, под сенью которого женщины ведут борьбу
за равные права.
-- А. Рот
%
Брак - это лотерея, но в случае проигрыша вы не можете порвать свой билет.
-- Ф. Ноулз
%
Британский солдат устоит против кого угодно, только не против Британского
министерства обороны.
-- Бернард Шоу
%
Век наш таков, что он гордится машинами, умеющими думать, и побаивается
людей, которые пытаются проявить ту же способность.
-- Г.Мамфорд Джонс
%
Военная мудрость есть понятие, заключающее противоречие в самом себе.
Война - слишком серьезное дело, чтобы доверять его военным.
-- Талейран
%
Выход из беды найти не столь просто, как попасть в нее.
-- Эд Хау
%
Граница в политической географии - воображаемая линия между двумя
государствами, отделяющая воображаемые права одного от воображаемых прав
другого.
-- А.Бирс
%
Да не устрашит тебя величие: одни рождаются великими, другие достигают
величия, третьим его навязывают.
-- Уильям Шекспир
%
Две тысячи лет нам поставляли примеры для подражания, и теперь ничто нас
не извиняет, если мы, воюя, воем плохо.
-- Т.Э. Лоуренс
%
Дипломная работа среднего выпускника университета есть не что иное, как
кости, перенесенные из одной могилы в другую.
-- Дж. Фрэнк Доуби
%
Для любой волнующей человека проблемы всегда легко найти решение -
простое, достижимое и ошибочное.
-- Г.Л. Менкен
%
Добрым словом и револьвером вы можете добиться гораздо большего, чем одним
только добрым словом.
-- Аль Капоне
%
Если вы не восходящий, значит, вы ниспадающий.
-- Стивен Поттер
%
Если честолюбивая мечта не заставляет вас страдать, значит, ее у вас нет.
-- К. Норрис
%
Идеалист тот, кто, заметив, что роза пахнет лучше капусты, заключает, что
и суп из нее будет лучше.
-- Г. Менкен
%
Жизнь что луковица - вы чистите ее, снимая слой за слоем, и иногда
плачете.
-- С. Сандберг
%
Когда люди вольны поступать как угодно, они обычно подражают друг другу.
-- Э. Хоффер
%
Коли все думают одинаково, значит, никто особенно и не думает.
-- У.Липпман
%
Компьютеры бесподобны: за несколько минут они могут совершить такую
грандиозную ошибку, какую не в состоянии сделать множество людей за многие
месяцы.
-- М. Мичэм
%
Логика - это искусство ошибаться с уверенностью в своей правоте.
-- Дж. У. Крач
%
Любовь - вещь идеальная, супружество - реальная; смешение реального с
идеальным никогда не проходит безнаказанно.
-- И. Гете
%
Любое ваше решение - это ошибка.
-- Эдуард Далберг
%
Мой способ шутить - это говорить правду. На свете нет ничего
смешнее.
-- Бернард Шоу
%
На моем веку было очень много прогресса, но, боюсь, не в том направлении.
-- О. Нэш
%
Нам мало добиться успеха. Надо еще, чтобы друзья наши потерпели крах.
-- Ларошфуко
%
Невеста - женщина, у которой виды на счастье остались позади.
-- А. Бирс
%
Нужно учредить Нобелевскую премию за остроумие. Без физиков, химиков,
экономистов мы, если прижмет, как-нибудь обойдемся. Без мира обычно тоже
обходимся. Без остроумия - пропадем.
-- Джордж Ф. Уилл
%
О несчастном случае мой подзащитный впервые узнал лишь тогда, когда этот
случай произошел.
-- Из речи адвоката
%
Первый и наихудший из всех подвохов - обмануть самого себя. Потом уже
легко впасть в любой грех.
-- Дж. Бэйли
%
По самой своей природе человек, чем старше он становится, тем больше
противится переменам, особенно переменам к лучшему.
-- Дж. Стейнбек
%
Поиск истины способен изрядно позабавить.
-- Вернон Говард
%
Полицейский находится на своем месте не для того, чтобы создавать
беспорядок; полицейский находится там, чтобы поддерживать беспорядок.
-- Ричард Дж. Дейли, мэр Чикаго
%
Посредственность - добродетель в глазах посредственных людей.
-- Ж. Жобер
%
Посредственный учитель излагает. Хороший учитель объясняет. Выдающийся
учитель показывает. Великий учитель вдохновляет.
-- Уильям Артур Уорд
%
Президенту в его окружении не нужны мужчины и женщины, умеющие только
поддакивать. Если он говорит "нет", мы все говорим "нет".
-- Элизабет Доул, помощница президента Рейгана
%
"Радость моя, мы живем в переходную эпоху", говорил Адам Еве по дороге из
рая.
-- У. Инге
%
"С нами такого случиться не может" - это фраза номер один в списке
знаменитых последних слов.
-- Дэвид Кросби
%
Самая большая ложь - это неверно понятая правда.
-- Уильям Джеймс
%
Скрипка - инструмент для щекотания человеческих ушей при помощи трения
лошадиного хвоста о внутренности кошки.
-- Амброз Бирс
%
Среди преподавателей большинство составляют те, кто не прервет чтение
своих лекций по навигации, даже если корабль уже тонет. Следствие:
путешествие длиною в тысячу миль завершается одним-единственным шагом.
-- Джеймс Г. Борен
%
Творческое мышление, возможно, означает всего-навсего понимание, что нет
никакой особой добродетели в том, чтобы вести дела так, как их всегда вели до
нас.
-- Рудольф Флеш
%
Технический прогресс лишь снабдил нас действенными средствами для движения
назад.
-- О. Хаксли
%
То, что мы называем прогрессом, представляет собой замену одной
неприятности другою.
-- Г. Эллис
%
Учитель прикасается к вечности: никто не может сказать, где кончается его
влияние.
-- Генри Адамс
%
Человеку надлежит жить с самим собой и постоянно заботиться, чтобы это
была хорошая кампания.
-- С.И. Хьюз
%
Эксперт - это человек, знающий все больше и больше о все меньшем и
меньшем. Следствие: колледж не может обеспечить компетентность; он может
обеспечить диплом.
-- Николас Батлер
%
Эксперт - это человек, который больше уже не думает; он знает.
-- К. Хаббард
%
Я не верю в коллективную мудрость невежественных индивидуумов.
-- Т. Карлейль
%
Я не против полиции, я просто боюсь ее.
-- Альфред Хичкок
%
Я никогда не мог взять в толк, почему из-за того только, что я выражаюсь
невразумительно, никто меня не понимает.
-- Милтон Мейер
%
Пожилые люди думают, что с тех пор, как они постарели, мир только теряет,
но ничего не приобретает.
-- Жеремена Сталь
%
Меня интересует мнение не тех людей, которые разбираются в данном вопросе,
а тех, которые сами кое-что сделали в одной из областей знания.
-- Hорберт Винер
%
Случайные открытия совершают только подготовленные умы.
-- Паскаль
%
Бывают услуги настолько большие, что рассчитаться за них можно только
неблагодарностью.
-- Дюма-отец
%
"Тоже неплохо!" - сказал зять, бросив камнем в собаку, а попав в тещу.
-- Плутарх. "Пир семи мудрецов".
%
Не ковыряй в носу перочинным ножиком. Лезвие легко ржавеет.
-- Из книги "Пи"
%
Очень много - иногда вполне достаточно для женщины.
-- Из книги "Ву"
%
В жизни можно рассчитывать только на самих себя. И то не всегда.
-- Тристан Бернар
%
Все было бы очень хорошо, если бы все наши поступки можно было бы совершать
дважды.
-- Гете
%
E = mC
-- Альберт Эйнштейн
%
Человек бывает таким, каким его создал бог, но преимущественно немного хуже.
-- Сервантес
%
Две параллельных линии полюбили друг друга. Трагедия!
-- Из книги "Пи"
%
Я знаток всех "и т. д., и т. п." и я знаю, когда за ними ничего больше
не скрывается.
-- Гомес де ля Серна
%
Одна туча может погрузить в темноту весь парк, одно слово может затемнить
самое большое счастье.
-- Гомес де ля Серна
%
Тот факт, что будильник не прозвенел, изменило уже много человеческих судеб.
-- Агата Кристи
%
Заполнять жизнь - это еще не значит обогащать ее.
-- Из книги "Пи"
%
Самым серьезным достоинством современного искусства является то, что, когда
эти произведения смотрят дети, они не задают таких вопросов, на которые
обычно бывает трудно отвечать.
-- Лорд Галлюкс
%
Замужних женщин значительно больше, чем женатых мужчин.
-- По данным американской статистики
%
Совесть - это тот голос, который говорит тебе, что не надо делать именно то,
что ты только что сделал.
-- Из книги "Пи"
%
И мелкие неприятности могут отравить жизнь, если нет крупных.
-- Р. Гомес де ля Серна
%
Счастлив тот, кто ни о чем не думает.
-- Софокл
%
Я не читаю газет. Все, о чем там стоит знать, всегда кто-нибудь расскажет.
-- Лорд Галлюкс
%
Недостаточно встать рано, надо еще и проснуться.
-- Из книги "Ву"
%
Высохшую реку не благодарят за ее прошлое.
-- Рабиндранат Тагор
%
Давать советы всегда плохо, но хорошего совета тебе никто не простит.
-- Оскар Уайльд
%
Устарели не только ответы, но даже сами вопросы.
-- Хемингуэй
%
Друзья, как арбузы: случается, что из десяти ни одного хорошего не выбрать.
-- Из книги "Пи"
%
Пока слушатели во время лекции поглядывают на часы, все в порядке. Страшно,
когда они начинают удивленно подносить часы к уху.
-- Из книги "Пи"
%
Нет правила, которого нельзя было бы нарушить ради более прекрасного.
-- Л. Бетховен
%
Прекрасна молодость, когда она в движении и знает, куда приложить свои силы.
-- Менандр
%
Простим горячке юных лет
И юный жар, и юный бред.
-- А. С. Пушкин
%
Грустно думать, что напрасно
Была нам молодость дана.
-- А. С. Пушкин
%
Всего больнее знать, что счастье было так близко - и ты сам его отверг.
-- Софокл
%
Настоящий художник настолько владеет искусством, насколько оно владеет им.
-- Г. Флобер
%
Великие люди сами сооружают себе пьедестал; статую воздвигнет будущее.
-- В. Гюго
%
...заслуги отца на сына не распространяются.
-- М. Сервантес
%
Давайте жить так, чтобы даже гробовщику стало жалко, когда мы умрем.
-- Марк Твен
%
- Обладаешь ли ты разумом?
- Обладаю.
- Почему же ты не пользуешься им?
-- Марк Авелий
%
Нет такой глупости, которой нельзя было бы исправить при помощи ума,
и нет такой мудрости, которой нельзя было бы испортить при помощи глупости.
-- В. Гёте
%
Оптимист верит, что мы живем в лучшем из миров.
Пессимист боится, что так оно и есть.
%
Пессимист видит темный туннель.
Оптимист видит свет в конце туннеля.
Реалист видит, что это на них мчится поезд.
И только машинист видит трех мудаков, тупящих на рельсах.
%
Мы познаем человека не по тому, что он знает, а по тому, чему он радуется.
-- Р.Тагор
%
Если вы уверены в победе вашей национальной сборной на Евро 2004, то вы либо
дурак, либо немец.
-- М.Задорнов
%
Нет некрасивых женщин - есть только женщины, не знающие, что они красивы.
-- Вивьен Ли
%
Любая сложная технология неотличима от волшебства.
-- Артур Кларк
%
Я люблю тебя не за то, кто ты, а за то, кто я, когда я с тобой.
-- Габриэль Гарсиа
%
Ни один человек не заслуживает твоих слез, а те, кто заслуживают,
не заставят тебя плакать.
-- Габриэль Гарсиа
%
Только потому что кто-то не любит тебя так, как тебе хочется, не значит,
что он не любит тебя всей душой.
-- Габриэль Гарсиа
%
Настоящий друг – это тот, кто будет держать тебя за руку
и чувствовать твоё сердце.
-- Габриэль Гарсиа
%
Худший способ скучать по человеку – это быть с ним и понимать,
что он никогда не будет твоим.
-- Габриэль Гарсиа
%
Никогда не переставай улыбаться, даже когда тебе грустно: кто-то может влюбиться
в твою улыбку.
-- Габриэль Гарсиа
%
Возможно, в этом мире ты всего лишь человек, но для кого-то ты – весь мир.
-- Габриэль Гарсиа
%
Не трать время на человека, который не стремится провести его с тобой.
-- Габриэль Гарсиа
%
Возможно, Бог хочет, чтобы мы встречали не тех людей до того, как встретим того
единственного человека. Чтобы, когда это случится, мы были благодарны.
-- Габриэль Гарсиа
%
Не плачь, потому что это закончилось. Улыбнись, потому что это было.
-- Габриэль Гарсиа
%
Всегда найдутся люди, которые причинят тебе боль. Нужно продолжать верить людям,
просто быть чуть осторожнее.
-- Габриэль Гарсиа
%
Стань лучше и сам пойми, кто ты, прежде чем встретишь нового человека и будешь
надеяться, что он тебя поймет.
-- Габриэль Гарсиа
%
Не прилагай столько усилий, все самое лучшее случается неожиданно.
-- Габриэль Гарсиа
%
Всё, что случаеется, имеет причину.
-- Габриэль Гарсиа

106
data/friday.txt Normal file
View File

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

1336
data/lat.txt Normal file

File diff suppressed because it is too large Load Diff

61
data/sample_config.json Normal file
View File

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

1455
lib/Bot/IRC.pm Normal file

File diff suppressed because it is too large Load Diff

198
lib/Bot/IRC/OnMessage.pm Normal file
View File

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

134
lib/BotLib.pm Normal file
View File

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

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

@@ -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 (/<br>/, $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:

126
lib/BotLib/Archeologist.pm Normal file
View File

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

58
lib/BotLib/Buni.pm Normal file
View File

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

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

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

124
lib/BotLib/Drink.pm Normal file
View File

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

133
lib/BotLib/Fisher.pm Normal file
View File

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

85
lib/BotLib/Fortune.pm Normal file
View File

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

54
lib/BotLib/Fox.pm Normal file
View File

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

96
lib/BotLib/Friday.pm Normal file
View File

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

70
lib/BotLib/Image.pm Normal file
View File

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

639
lib/BotLib/Image/Flickr.pm Normal file
View File

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

125
lib/BotLib/Karma.pm Normal file
View File

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

53
lib/BotLib/Kitty.pm Normal file
View File

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

73
lib/BotLib/Lat.pm Normal file
View File

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

62
lib/BotLib/Monkeyuser.pm Normal file
View File

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

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

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

176
lib/BotLib/Weather.pm Normal file
View File

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

42
lib/BotLib/Xkcd.pm Normal file
View File

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

58
lib/IRCBot.pm Normal file
View File

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