Initial commit
This commit is contained in:
5
.perlcriticrc
Normal file
5
.perlcriticrc
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
[-Modules::RequireExplicitPackage]
|
||||||
|
[-Modules::RequireVersionVar]
|
||||||
|
[-CodeLayout::RequireTidyCode]
|
||||||
|
[-ControlStructures::ProhibitUnlessBlocks]
|
||||||
|
[-Subroutines::ProhibitSubroutinePrototypes]
|
||||||
25
LICENSE
Normal file
25
LICENSE
Normal file
@@ -0,0 +1,25 @@
|
|||||||
|
BSD 2-Clause License
|
||||||
|
|
||||||
|
Copyright (c) 2020, Sergei Fedosov
|
||||||
|
All rights reserved.
|
||||||
|
|
||||||
|
Redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
1. Redistributions of source code must retain the above copyright notice, this
|
||||||
|
list of conditions and the following disclaimer.
|
||||||
|
|
||||||
|
2. Redistributions in binary form must reproduce the above copyright notice,
|
||||||
|
this list of conditions and the following disclaimer in the documentation
|
||||||
|
and/or other materials provided with the distribution.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||||
|
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||||
|
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||||
|
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||||
|
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||||
|
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||||
|
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||||
|
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||||
|
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
32
README
Normal file
32
README
Normal file
@@ -0,0 +1,32 @@
|
|||||||
|
mbot-brains
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
What is it?
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
Sample PSGI service implementing markov chain chat module.
|
||||||
|
|
||||||
|
|
||||||
|
What for?
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
For fun. And for MBot framework.
|
||||||
|
|
||||||
|
|
||||||
|
How to run it?
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
First things you need - some modules from cpan or from your distro. See
|
||||||
|
cpanfile. You can bootstrap required modules to vendor_perl dir with cpanm and
|
||||||
|
bootstrap.sh script.
|
||||||
|
|
||||||
|
To run this service you need application server capable to run PSGI apps.
|
||||||
|
|
||||||
|
There are plenty of PSGI servers: uWSGI, Starman, Plack, Nginx UNIT, Twiggy,
|
||||||
|
etc. I prefer uWSGI, but Starman can provide more insights for debugging.
|
||||||
|
|
||||||
|
With uwsgi:
|
||||||
|
/usr/bin/uwsgi --ini /path/to/uwsgi.ini --pidfile /path/to/pidile.pid \
|
||||||
|
--logto /path/to/uwsgi.log --psgi /path/to/mbot-brains.psgi \
|
||||||
|
--perl-local-lib /path/to/vendor_perl
|
||||||
|
|
||||||
|
With Starman:
|
||||||
|
PERl5LIB=/path/to/vendor_perl /path/to/starman --listen 127.0.0.1:3000 \
|
||||||
|
/path/to/mbot-brains.psgi
|
||||||
5
bootstrap.sh
Normal file
5
bootstrap.sh
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
cpanm -l vendor_perl --self-contained --force --update --installdeps .
|
||||||
|
|
||||||
|
# vim: set ft=sh noet ai ts=4 sw=4 sts=4:
|
||||||
4
cpanfile
Normal file
4
cpanfile
Normal file
@@ -0,0 +1,4 @@
|
|||||||
|
requires 'Plack';
|
||||||
|
requires 'Hailo';
|
||||||
|
requires 'Config::INI::Reader';
|
||||||
|
requires 'local::lib';
|
||||||
2
data/config.ini
Normal file
2
data/config.ini
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
[brain]
|
||||||
|
dir = data
|
||||||
79
mbot-brains.psgi
Normal file
79
mbot-brains.psgi
Normal file
@@ -0,0 +1,79 @@
|
|||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use utf8;
|
||||||
|
|
||||||
|
use lib qw(. ./vendor_perl/lib/perl5);
|
||||||
|
|
||||||
|
use Config::INI::Reader;
|
||||||
|
use Hailo;
|
||||||
|
|
||||||
|
my $config = Config::INI::Reader->read_file ('data/config.ini');
|
||||||
|
my $braindir = $config->{brain}->{dir};
|
||||||
|
|
||||||
|
unless (-d $braindir) {
|
||||||
|
die "Directory $braindir does not exists\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
my %brain;
|
||||||
|
|
||||||
|
# just return answer
|
||||||
|
sub answer (@) {
|
||||||
|
my $chat = shift;
|
||||||
|
my $phrase = shift;
|
||||||
|
|
||||||
|
unless (defined $brain{$chat}) {
|
||||||
|
my $brain = sprintf '%s/%s.brain.sqlite', $braindir, $chat;
|
||||||
|
|
||||||
|
$brain{$chat} = Hailo->new (
|
||||||
|
brain => $brain,
|
||||||
|
order => 3,
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
my $msg = $brain{$chat}->reply($phrase);
|
||||||
|
|
||||||
|
return ('200', 'text/plain', $msg);
|
||||||
|
}
|
||||||
|
|
||||||
|
# swallow phrase and return answer
|
||||||
|
sub learn (@) {
|
||||||
|
my $chat = shift;
|
||||||
|
my $phrase = shift;
|
||||||
|
|
||||||
|
unless (defined $brain{$chat}) {
|
||||||
|
my $brain = sprintf '%s/%s.brain.sqlite', $braindir, $chat;
|
||||||
|
|
||||||
|
$brain{$chat} = Hailo->new (
|
||||||
|
brain => $brain,
|
||||||
|
order => 3,
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
$brain{$chat}->learn($phrase);
|
||||||
|
return ('200', 'text/plain', 'OK');
|
||||||
|
}
|
||||||
|
|
||||||
|
my $app = sub {
|
||||||
|
my $env = shift;
|
||||||
|
|
||||||
|
my $msg = "Not Found\n";
|
||||||
|
my $status = '404';
|
||||||
|
my $content = 'text/plain';
|
||||||
|
|
||||||
|
if ($env->{PATH_INFO} eq '/learn' && $env->{REQUEST_METHOD} eq 'POST') {
|
||||||
|
($status, $content, $msg) = learn ($env->{HTTP_CHAT}, $env->{HTTP_PHRASE});
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($env->{PATH_INFO} eq '/answer' && $env->{REQUEST_METHOD} eq 'POST') {
|
||||||
|
($status, $content, $msg) = answer ($env->{HTTP_CHAT}, $env->{HTTP_PHRASE});
|
||||||
|
}
|
||||||
|
|
||||||
|
return [
|
||||||
|
$status,
|
||||||
|
[ 'Content-Type' => $content, 'Content-Length' => length $msg ],
|
||||||
|
[ $msg ],
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
__END__
|
||||||
|
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||||
17
uwsgi.ini
Normal file
17
uwsgi.ini
Normal file
@@ -0,0 +1,17 @@
|
|||||||
|
[uwsgi]
|
||||||
|
http-socket = 127.0.0.1:4000
|
||||||
|
tcp-nodelay = true
|
||||||
|
tcp-fastopen = 64
|
||||||
|
thunder-lock = true
|
||||||
|
logformat = %(ctime) %(var.REMOTE_ADDR) %(var.REQUEST_METHOD) %(var.REQUEST_URI) %(status) %(rsize) %(msecs)
|
||||||
|
log-reopen = yes
|
||||||
|
processes = 1
|
||||||
|
plugins = psgi
|
||||||
|
need-app = true
|
||||||
|
reload-mercy = 5
|
||||||
|
buffer-size = 32768
|
||||||
|
log-5xx = true
|
||||||
|
log-4xx = true
|
||||||
|
disable-logging = true
|
||||||
|
die-on-term = true
|
||||||
|
perl-exec = /dev/zero
|
||||||
Reference in New Issue
Block a user