aleesa-bot/aleesa-phrases
Archived
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
eleksir
2022-01-02 16:24:49 +03:00
commit 40b9bb03c3
23 changed files with 4832 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
_Deparsed_XSubs.pm
.idea/**
.vscode/**
.vstags
*.pid
*.log
data/config.json
vendor_perl/**

51
.perlcriticrc Normal file
View File

@@ -0,0 +1,51 @@
[-ControlStructures::ProhibitUnlessBlocks]
# oh. c'mon. just a little bit
[-ValuesAndExpressions::ProhibitNoisyQuotes]
# that is not constructive constraint at all
[-Variables::ProhibitPackageVars]
# sad, but true - this is how real world actually works
[-NamingConventions::Capitalization]
# eh?
[-ControlStructures::ProhibitPostfixControls]
# just a tiny bit?
[-Miscellanea::ProhibitTies]
# seriously?
[-RegularExpressions::RequireExtendedFormatting]
# good to be, but i don't like to write a long book near each regexp desribing what it does
[-InputOutput::RequireBriefOpen]
# I'm closing that fucking FH as soon as fucking possible, is that clear, you, little shit?
[-ValuesAndExpressions::ProhibitEmptyQuotes]
# totally garbage rule
[-CodeLayout::RequireTidyCode]
# just fuck off
[-CodeLayout::ProhibitParensWithBuiltins]
# nope
[-InputOutput::RequireCheckedClose]
# let's imagine situation that close() returns an error - what i'm supposed to do?
[-RegularExpressions::RequireLineBoundaryMatching]
# i don't give a shit to folks that think in sed|awk way - it's fucking perl, man, it uses perl regexes, not those
# pricky posix ones!
[-ValuesAndExpressions::ProhibitMagicNumbers]
# in this program it is easy to guess what "magick" numbers means, just rtfm, don't be lazy asshole.
[-Modules::ProhibitExcessMainComplexity]
# okay. next time I promise I'll do that.
[-RegularExpressions::ProhibitEscapedMetacharacters]
# no, i have to allow this, so go play in your sandbox in your kindergarden
[-ControlStructures::ProhibitCascadingIfElse]
# just shut the fuck up

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

38
README Normal file
View File

@@ -0,0 +1,38 @@
aleesa-phrases
-----------------------------------------------------------------------------------------------------------------------
Отвечалка готовыми словарными фразами.
* Фразы основанные на цепях маркова из крылатых латинских изречений
* Фортунки (на основе фраз из fortune_mod)
* Пятница
* Пословицы и поговорки
Механика работы
-----------------------------------------------------------------------------------------------------------------------
Сервис подписан на канал phrases. В этот канал пишет другой демоночек - aleesa-misc. А ещё aleesa-cron (чтобы фортунки
по утрам рассылать)
Ответ направляется в redis-канал, указанный в поле plugin входящего сообщения.
Формат протокола - см README от aleesa-misc.
Как это запустить?
-----------------------------------------------------------------------------------------------------------------------
Понадобится perl, cpanm и local::lib, а также несколько разных devel-пакетов для разных библиотек. Как правило, это
находится методом тыка, но точно понадобятся sqlite-devel, bdb-devel (или db-devel), hiredis-devel. Кроме того,
понадобятся development tools - gcc, gcc-g++, perl-devel, make, cmake и так далее.
Приложение тестировалось на alpine linux x86_64 3.12, со встроенным perl-5.32.1
В каталоге с приложением под целевым пользователем запускаем bash bootstrap.sh Ждём с надеждой, что оно не обломится в
пути.
Если всё хорошо, то после запуска redis-а, создания data/config.json из data/config_sample.json, можно запускать и само
приложение.
В каталоге contrib находится скрипт для alpine linux, системы инициализации openrc. Этот скрипт достаточно положить В
/etc/init.d/aleesa-misc сконфигурить сервис по инструкции выше и после этого сервис запускается командой:
service aleesa-misc start
в автозагрузку его можно прописать через команду
rc-update add aleesa-misc default

189
bin/aleesa-phrases Executable file
View File

@@ -0,0 +1,189 @@
#!/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;
# До фактического запуска логики программы, сменим рабочий каталог, чтобы подцепить либы
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");
no Cwd;
use Cwd::utf8 qw (chdir abs_path);
use File::Basename qw (basename dirname);
use File::Path qw (make_path);
use Log::Any qw ($log);
use Log::Any::Adapter;
use Log::Any::For::Std;
use POSIX qw (setgid setuid setsid);
use Conf qw (LoadConf);
use Phrases qw (RunPhrases);
sub daemonize;
sub __fork;
sub __signal_handler;
local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $UID;
my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
my $C = LoadConf ();
my $loglevel = $C->{'loglevel'} // 'notice';
my $logfile;
if (defined $C->{'log'}) {
$logfile = $C->{'log'};
} elsif (defined $C->{'debug_log'}) {
$logfile = $C->{'debug_log'};
}
# Если мы запускаемся под рутом, то попробуем создать необходимые служебные каталоги и простать на них корректных
# владельца и права
if ($UID == 0) {
my $user = $C->{user};
unless (defined $user) {
die "Unable to run as root, please define unprivileged user in config.json\n";
}
my ($uid, $gid) = (getpwnam $user)[2,3];
unless (-d $piddir) {
make_path (
$piddir, {
uid => $uid,
group => $gid
}
);
}
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";
}
}
# Переключаемся на "рабочего" пользователя и сбрасываем привилегии.
setgid ($gid) or die "Unable to switch to group of $user($OS_ERROR)\n";
setuid ($uid) or die "Unable to switch to account $user($OS_ERROR)\n";
} else {
$piddir = $workdir;
}
if (defined $logfile) {
Log::Any::Adapter->set ('File', $logfile, log_level => $loglevel);
} else {
Log::Any::Adapter->set ('File', '/dev/null');
}
# По-умолчанию, демонизируемся, если явно не указано, что этого делать не надо
if (defined ($C->{daemonize}) && $C->{daemonize}) {
daemonize ();
} elsif ( ! defined ($C->{daemonize})) {
daemonize ();
}
# Запишем pid-файл
my $apath = abs_path $PROGRAM_NAME;
unless (defined $apath) {
$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
exit 1;
};
my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
$log->info ("[INFO] Creating pidfile at $pidfile");
open my $MYPID, '>', $pidfile or do {
$log->fatal ("[FATAL] Error opening $pidfile: $OS_ERROR");
exit 1;
};
print {$MYPID} $PID or do {
$log->fatal ("[FATAL] Error writing to $pidfile: $OS_ERROR");
exit 1;
};
close $MYPID; ## no critic (InputOutput::RequireCheckedSyscalls
# При наличии хака в лице Mojo::IOLoop::Signal в Phrases.pm, установка хэндлера в этом месте - это фактически
# подстраховка на случай ядерной войны.
local $SIG{INT} = \&__signal_handler;
local $SIG{TERM} = \&__signal_handler;
# Поставим правильное имя процесса в proctitle
$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars)
# И запустим уже наш сервис
RunPhrases ();
if (-f $pidfile) {
unlink $pidfile;
}
exit 0;
sub daemonize {
__fork ();
POSIX::setsid ();
open STDIN, '<', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
# we handle STDOUT && STDERR via Log::Any::For::Std, so do not close them explicitly
#open STDOUT, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
#open STDERR, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
__fork ();
umask 0;
return;
}
sub __fork {
my $pid = fork;
unless (defined $pid) {
$log->fatal ("[FATAL] Can't fork: $OS_ERROR");
exit 1;
}
if ($pid != 0) {
exit;
}
return;
}
sub __signal_handler {
$log->info ("[INFO] Caught a signal $OS_ERROR");
if (-f $pidfile) {
unlink $pidfile;
}
exit 0;
}
__END__
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

26
bin/fortune_seed.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 Fortune qw (Seed);
Seed ();
exit 0;

26
bin/friday_seed.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 Friday qw (Seed);
Seed ();
exit 0;

26
bin/proverb_seed.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 Proverb 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 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 --installdeps .
# vim: set ft=sh noet ai ts=4 sw=4 sts=4:

11
contrib/aleesa-phrases.openrc Normal file
View File

@@ -0,0 +1,11 @@
#!/sbin/openrc-run
name="$SVCNAME"
command="/var/lib/$SVCNAME/bin/$SVCNAME"
pidfile="/var/run/$SVCNAME/$SVCNAME.pid"
depend() {
need net redis
use dns
after redis
}

27
cpanfile Normal file
View File

@@ -0,0 +1,27 @@
requires 'Carp', '0';
requires 'Cwd::utf8', '==0.011';
requires 'Data::Dumper', '==2.183';
requires 'Encode', '==3.16';
requires 'English', '==1.11';
requires 'EV', '==4.33';
requires 'File::Basename', '0';
requires 'File::Path', '==2.18';
requires 'Hailo', '==0.75';
requires 'JSON', '==4.03';
requires 'JSON::XS', '==4.03';
requires 'local::lib', '==2.000028';
requires 'Log::Any', '==1.710';
requires 'Log::Any::Adapter', '==1.710';
requires 'Log::Any::For::Std', '==0.05';
requires 'Math::Random::Secure', '==0.080001';
requires 'Mojolicious', '==9.22';
requires 'Mojo::IOLoop', '0';
requires 'Mojo::IOLoop::Signal', '0.003';
requires 'Mojo::Redis', '==3.27';
requires 'Mojo::Util', '0';
requires 'open', '0';
requires 'POSIX', '0';
requires 'Protocol::Redis::XS', '0';
requires 'SQLite_File', '==0.1006';
requires 'utf8', '0';
requires 'version', '0';

44
data/config_sample.json Normal file
View File

@@ -0,0 +1,44 @@
{
# server address
"server" : "redis",
"port" : "6379",
"channels": [
"phrases"
],
# should we fork() and become unix daemon?
"daemonize": 1,
# unprivileged system user to run bot as
"user" : "nobody",
# logs goes there
"log" : "/var/log/aleesa-weba/aleesa-phrases.log",
"loglevel": "notice",
# ditto
"pid" : "/var/run/aleesa-phrases/aleesa-phrases.pid",
# maximal amount of message forwardings, to avoid endless loops
"forwards_max" : 5,
"lat" : {
"brain": "data/lat/brain.sqlite",
"src": "data/lat.txt"
},
"fortune" : {
"dir" : "data/fortune",
"srcdir" : "data/fortune_src"
},
"proverb" : {
"dir" : "data/proverb",
"srcdir" : "data/proverb_src"
},
"friday" : {
"dir" : "data/friday",
"src" : "data/friday.txt"
}
}

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
View File

File diff suppressed because it is too large Load Diff

1719
data/proverb_src/proverb.txt Normal file
View File

File diff suppressed because it is too large Load Diff

37
lib/Conf.pm Normal file
View File

@@ -0,0 +1,37 @@
package Conf;
# Загружает конфиг
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Encode qw (encode decode);
use JSON::XS;
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (LoadConf);
sub LoadConf {
my $c = 'data/config.json';
open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
my $json;
my $len = (stat $c) [7];
my $readlen = read $CH, $json, $len;
$json = encode 'UTF-8', $json;
unless ($readlen) {
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATAL] Unable to read $c: $OS_ERROR\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:

87
lib/Fortune.pm Normal file
View File

@@ -0,0 +1,87 @@
package Fortune;
# Прокатят любые источники из fortune_mod. Текстовой файл с разделителем "\n%\n" мнжду фразами.
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck croak);
use File::Path qw (make_path);
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use SQLite_File;
use 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";
}
tie my @fortune, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR";
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/^\.+$/) { ## no critic (RegularExpressions::RequireDotMatchAnything)
next;
}
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR";
# 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;
}
# Просто вернём ответ
sub Fortune () {
my $backingfile = sprintf '%s/fortune.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do {
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
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:

97
lib/Friday.pm Normal file
View File

@@ -0,0 +1,97 @@
package Friday;
# Данные модуля спёрты с 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 (cluck croak);
use File::Path qw (make_path);
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use SQLite_File;
use 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 / \|\| /; ## no critic (RegularExpressions::RequireDotMatchAnything), do you see ANY dots here?
my @daylist = split(//, $days); ## no critic (RegularExpressions::RequireDotMatchAnything), do you see ANY dots here?
foreach my $day (@daylist) {
unless (defined $day) {
next;
}
unless ($day =~ /^\d$/) { ## no critic (RegularExpressions::RequireDotMatchAnything), do you see ANY dots here?
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 {
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n");
return '';
};
my $phrase = $array[irand ($#array + 1)];
utf8::decode $phrase;
untie @array;
return $phrase;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4:

75
lib/Lat.pm Normal file
View File

@@ -0,0 +1,75 @@
package Lat;
# Крылатые латинские выражения спёрты с 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 (cluck);
use File::Basename qw (dirname);
use File::Path qw (make_path);
use Hailo;
use Log::Any qw ($log);
use 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 {
cluck "Unable to create $braindir: $OS_ERROR";
exit 1;
};
}
my $lat = Hailo->new (
brain => $brain,
# В нашем случае среднее количество слов в фразе равно 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;
}
# Просто вернём ответ
sub Lat () {
my $braindir = dirname $brain;
unless (-d $braindir) {
$log->error ("[ERROR] No lat module data: $braindir is absent! Train lat first.");
return '';
}
unless (-f $brain) {
$log->error ("[ERROR] No lat module data: $brain is absent! Train lat first.");
return '';
}
my $lat = Hailo->new (
brain => $brain,
# В нашем случае среднее количество слов в фразе равно 3
order => 2,
save_on_exit => 0
);
return $lat->reply ();
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4:

161
lib/Phrases.pm Normal file
View File

@@ -0,0 +1,161 @@
package Phrases;
# Общие модули - синтаксис, кодировки итд
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
# Модули для работы приложения
use Log::Any qw ($log);
# Чтобы "уж точно" использовать hiredis-биндинги, загрузим этот модуль перед Mojo::Redis
use Protocol::Redis::XS;
use Mojo::Redis;
use Mojo::IOLoop;
use Mojo::IOLoop::Signal;
use Data::Dumper;
use Conf qw (LoadConf);
use Fortune qw (Fortune);
use Friday qw (Friday);
use Lat qw (Lat);
use Proverb qw (Proverb);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (RunPhrases);
my $c = LoadConf ();
my $fwd_cnt = $c->{'forward_max'} // 5;
# Основной парсер
my $parse_message = sub {
my $self = shift;
my $m = shift;
my $answer = $m;
my $send_to = $m->{plugin};
my $reply;
if (defined $answer->{misc}) {
unless (defined $answer->{misc}->{fwd_cnt}) {
$answer->{misc}->{fwd_cnt} = 1;
} else {
if ($answer->{misc}->{fwd_cnt} > $fwd_cnt) {
$log->error ('Forward loop detected, discarding message.');
$log->debug (Dumper $m);
return;
} else {
$answer->{misc}->{fwd_cnt}++;
}
}
unless (defined $answer->{misc}->{answer}) {
$answer->{misc}->{answer} = 1;
}
unless (defined $answer->{misc}->{csign}) {
$answer->{misc}->{csign} = '!';
}
} else {
$answer->{misc}->{answer} = 1;
$answer->{misc}->{csign} = '!';
}
$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
if (substr ($m->{message}, 0, 1) eq $answer->{misc}->{csign}) {
if ((substr ($m->{message}, 1) eq 'lat' || substr ($m->{message}, 1) eq 'лат')) {
$reply = Lat ();
} elsif (substr ($m->{message}, 1) eq 'friday' || substr ($m->{message}, 1) eq 'пятница') {
$reply = Friday ();
} elsif (substr ($m->{message}, 1) eq 'proverb' || substr ($m->{message}, 1) eq 'пословица') {
$reply = Proverb ();
} elsif (substr ($m->{message}, 1) eq 'fortune' || substr ($m->{message}, 1) eq 'фортунка' ||
substr ($m->{message}, 1) eq 'f' || substr ($m->{message}, 1) eq 'ф') {
if ($m->{plugin} eq 'telegram') {
$reply = sprintf "```\n%s\n```\n", trim (Fortune ());
} else {
$reply = trim (Fortune ());
}
}
}
$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));
if (defined $reply && $answer->{misc}->{answer}) {
$answer->{message} = $reply;
$self->json ($send_to)->notify (
$send_to => $answer
);
}
return;
};
my $__signal_handler = sub {
my ($self, $name) = @_;
$log->info ("[INFO] Caught a signal $name");
if (defined $main::pidfile && -f $main::pidfile) {
unlink $main::pidfile;
}
exit 0;
};
# main loop, он же event loop
sub RunPhrases {
$log->info ("[INFO] Connecting to $c->{server}, $c->{port}");
my $redis = Mojo::Redis->new (
sprintf 'redis://%s:%s/1', $c->{server}, $c->{port}
);
$log->info ('[INFO] Registering connection-event callback');
$redis->on (
connection => sub {
my ($r, $connection) = @_;
$log->info ('[INFO] Triggering callback on new client connection');
# Залоггируем ошибку, если соединение внезапно порвалось.
$connection->on (
error => sub {
my ($conn, $error) = @_;
$log->error ("[ERROR] Redis connection error: $error");
return;
}
);
return;
}
);
my $pubsub = $redis->pubsub;
my $sub;
$log->info ('[INFO] Subscribing to redis channels');
foreach my $channel (@{$c->{channels}}) {
$log->debug ("[DEBUG] Subscribing to $channel");
$sub->{$channel} = $pubsub->json ($channel)->listen (
$channel => sub { $parse_message->(@_); }
);
}
Mojo::IOLoop::Signal->on (
TERM => $__signal_handler,
INT => $__signal_handler
);
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
return;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

89
lib/Proverb.pm Normal file
View File

@@ -0,0 +1,89 @@
package Proverb;
# Пословицы и поговорки
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck croak);
use File::Path qw (make_path);
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use Mojo::Util qw (trim);
use SQLite_File;
use Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Seed Proverb);
my $c = LoadConf ();
my $dir = $c->{proverb}->{dir};
my $srcdir = $c->{proverb}->{srcdir};
sub Seed () {
unless (-d $dir) {
make_path ($dir) || croak "Unable to create $dir: $OS_ERROR";
}
my $backingfile = sprintf '%s/proverb.sqlite', $dir;
if (-f $backingfile) {
unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR";
}
tie my @proverb, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR";
opendir (my $srcdirhandle, $srcdir) || croak "Unable to open $srcdir: $OS_ERROR";
while (my $proverbfile = readdir $srcdirhandle) {
my $srcfile = sprintf '%s/%s', $srcdir, $proverbfile;
unless (-f $srcfile) {
next;
}
if ($proverbfile =~ m/^\.+$/) { ## no critic (RegularExpressions::RequireDotMatchAnything), do you see ANY dots here?
next;
}
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR";
while (readline $fh) {
chomp;
my $str = trim ($_);
if ($str ne '') {
push @proverb, $str;
}
}
close $fh; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
}
closedir $srcdirhandle;
untie @proverb;
return;
}
# Просто вернём ответ
sub Proverb () {
my $backingfile = sprintf '%s/proverb.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do {
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
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: