Initial commit. Split bot from myapi as separate application.
This commit is contained in:
eleksir
194
lib/botlib.pm
Normal file
194
lib/botlib.pm
Normal file
@@ -0,0 +1,194 @@
|
||||
package botlib;
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
use utf8;
|
||||
use open qw(:std :utf8);
|
||||
|
||||
use HTTP::Tiny;
|
||||
use URI::URL;
|
||||
use JSON::XS qw(decode_json encode_json);
|
||||
use Digest::MD5 qw(md5_base64);
|
||||
use DB_File;
|
||||
|
||||
use conf;
|
||||
|
||||
use vars qw/$VERSION/;
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT = qw(weather);
|
||||
|
||||
$VERSION = "1.0";
|
||||
|
||||
my $c = loadConf();
|
||||
|
||||
sub weather($) {
|
||||
my $city = shift;
|
||||
while (substr($city, -1) eq "\n") { chomp($city); }
|
||||
while (substr($city, 0, 1) eq "\n") { $city = substr($city, 1); }
|
||||
|
||||
return "Мне нужно ИМЯ города." if ($city eq '');
|
||||
return "Длинновато для названия города." if (length($city) > 80);
|
||||
|
||||
$city = ucfirst($city);
|
||||
my $w = __weather($city);
|
||||
my $reply;
|
||||
|
||||
if ($w) {
|
||||
if ($w->{temperature_min} == $w->{temperature_max}) {
|
||||
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
|
||||
$w->{name},
|
||||
$w->{country},
|
||||
ucfirst($w->{description}),
|
||||
$w->{wind_direction},
|
||||
$w->{wind_speed},
|
||||
$w->{temperature_min},
|
||||
$w->{temperature_feelslike},
|
||||
$w->{humidity},
|
||||
$w->{pressure}
|
||||
);
|
||||
} else {
|
||||
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
|
||||
$w->{name},
|
||||
$w->{country},
|
||||
ucfirst($w->{description}),
|
||||
$w->{wind_direction},
|
||||
$w->{wind_speed},
|
||||
$w->{temperature_min},
|
||||
$w->{temperature_max},
|
||||
$w->{temperature_feelslike},
|
||||
$w->{humidity},
|
||||
$w->{pressure}
|
||||
);
|
||||
}
|
||||
} else {
|
||||
$reply = "Я не знаю, какая погода в $city";
|
||||
}
|
||||
|
||||
return $reply;
|
||||
}
|
||||
|
||||
sub __weather($) {
|
||||
my $city = shift;
|
||||
$city = __urlencode($city);
|
||||
my $id = md5_base64($city);
|
||||
my $appid = $c->{openweathermap}->{appid};
|
||||
my $now = time();
|
||||
my $fc;
|
||||
my $w;
|
||||
|
||||
# attach to cache data
|
||||
tie my %cachetime, 'DB_File', $c->{openweathermap}->{cachetime} or do {
|
||||
warn "Something nasty happen when cachetime ties to its data: $!";
|
||||
return undef;
|
||||
};
|
||||
|
||||
tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do {
|
||||
warn "Something nasty happen when cachedata ties to its data: $!";
|
||||
return undef;
|
||||
};
|
||||
|
||||
# lookup cache
|
||||
if (defined ($cachetime{$id}) && ($now - $cachetime{$id}) < 10800) {
|
||||
$fc = decode_json($cachedata{$id});
|
||||
} else {
|
||||
my $r;
|
||||
|
||||
# try 3 times and giveup
|
||||
for (my $counter = 0; $counter < 3; $counter++) {
|
||||
next if ($r->{success});
|
||||
my $http = HTTP::Tiny->new(timeout => 3);
|
||||
$r = $http->get(sprintf("http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s", $city, $appid));
|
||||
sleep 2;
|
||||
}
|
||||
|
||||
# all 3 times can give error, so check it here
|
||||
if ($r->{success}) {
|
||||
$fc = eval { decode_json($r->{content}) };
|
||||
|
||||
if ($@) {
|
||||
warn "[WARN] openweathermap returns corrupted json: $@";
|
||||
untie %cachetime;
|
||||
untie %cachedata;
|
||||
return undef;
|
||||
};
|
||||
|
||||
$cachetime{$id} = $now;
|
||||
$cachedata{$id} = encode_json($fc);
|
||||
} else {
|
||||
untie %cachetime;
|
||||
untie %cachedata;
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
untie %cachetime;
|
||||
untie %cachedata;
|
||||
|
||||
# TODO: check all of this for existance
|
||||
$w->{'name'} = $fc->{name};
|
||||
$w->{'state'} = $fc->{state};
|
||||
$w->{'country'} = $fc->{sys}->{country};
|
||||
$w->{'longitude'} = $fc->{coord}->{lon};
|
||||
$w->{'latitude'} = $fc->{coord}->{lat};
|
||||
$w->{'temperature_min'} = int($fc->{main}->{temp_min} - 273.15);
|
||||
$w->{'temperature_max'} = int($fc->{main}->{temp_max} - 273.15);
|
||||
$w->{'temperature_feelslike'} = int($fc->{main}->{feels_like} - 273.15);
|
||||
$w->{'humidity'} = $fc->{main}->{humidity};
|
||||
$w->{'pressure'} = int($fc->{main}->{pressure} * 0.75006375541921);
|
||||
$w->{'description'} = $fc->{weather}->[0]->{description};
|
||||
$w->{'wind_speed'} = $fc->{wind}->{speed};
|
||||
$w->{'wind_direction'} = 'разный';
|
||||
my $dir = int($fc->{wind}->{deg} + 0);
|
||||
|
||||
if ($dir == 0) {
|
||||
$w->{'wind_direction'} = 'северный';
|
||||
} elsif ($dir > 0 && $dir <= 30) {
|
||||
$w->{'wind_direction'} = 'северо-северо-восточный';
|
||||
} elsif ($dir > 30 && $dir <= 60) {
|
||||
$w->{'wind_direction'} = 'северо-восточный';
|
||||
} elsif ($dir > 60 && $dir < 90) {
|
||||
$w->{'wind_direction'} = 'восточно-северо-восточный';
|
||||
} elsif ($dir == 90) {
|
||||
$w->{'wind_direction'} = 'восточный';
|
||||
} elsif ($dir > 90 && $dir <= 120) {
|
||||
$w->{'wind_direction'} = 'восточно-юго-восточный';
|
||||
} elsif ($dir > 120 && $dir <= 150) {
|
||||
$w->{'wind_direction'} = 'юговосточный';
|
||||
} elsif ($dir > 150 && $dir < 180) {
|
||||
$w->{'wind_direction'} = 'юго-юго-восточный';
|
||||
} elsif ($dir == 180) {
|
||||
$w->{'wind_direction'} = 'южный';
|
||||
} elsif ($dir > 180 && $dir <= 210) {
|
||||
$w->{'wind_direction'} = 'юго-юго-западный';
|
||||
} elsif ($dir > 210 && $dir <= 240) {
|
||||
$w->{'wind_direction'} = 'юго-западный';
|
||||
} elsif ($dir > 240 && $dir < 270) {
|
||||
$w->{'wind_direction'} = 'западно-юго-западный';
|
||||
} elsif ($dir == 270) {
|
||||
$w->{'wind_direction'} = 'западный';
|
||||
} elsif ($dir > 270 && $dir <= 300) {
|
||||
$w->{'wind_direction'} = 'западно-северо-западный';
|
||||
} elsif ($dir > 300 && $dir <= 330) {
|
||||
$w->{'wind_direction'} = 'северо-западный';
|
||||
} elsif ($dir > 330 && $dir < 360) {
|
||||
$w->{'wind_direction'} = 'северо-северо-западный';
|
||||
} elsif ($dir == 360) {
|
||||
$w->{'wind_direction'} = 'северный';
|
||||
}
|
||||
|
||||
return $w;
|
||||
}
|
||||
|
||||
sub __urlencode($) {
|
||||
my $str = shift;
|
||||
my $urlobj = url $str;
|
||||
$str = $urlobj->as_string;
|
||||
$urlobj = undef; undef $urlobj;
|
||||
return $str;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
67
lib/conf.pm
Normal file
67
lib/conf.pm
Normal file
@@ -0,0 +1,67 @@
|
||||
package conf;
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
use utf8;
|
||||
use open qw(:std :utf8);
|
||||
|
||||
use vars qw/$VERSION/;
|
||||
use Fcntl qw(O_WRONLY O_CREAT O_TRUNC);
|
||||
use JSON::XS qw(decode_json encode_json);
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT = qw(loadConf saveConf);
|
||||
|
||||
$VERSION = "1.0";
|
||||
sub loadConf ();
|
||||
sub saveConf ($);
|
||||
|
||||
sub loadConf () {
|
||||
my $c = "data/config.json";
|
||||
open (C, "<", $c) or die "[FATA] No conf at $c: $!\n";
|
||||
my $len = (stat ($c)) [7];
|
||||
my $json;
|
||||
my $readlen = read (C, $json, $len);
|
||||
|
||||
unless ($readlen) {
|
||||
close C;
|
||||
die "[FATA] Unable to read $c: $!\n";
|
||||
}
|
||||
|
||||
if ($readlen != $len) {
|
||||
close C;
|
||||
die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n";
|
||||
}
|
||||
|
||||
close C;
|
||||
return decode_json ($json);
|
||||
}
|
||||
|
||||
sub saveConf($) {
|
||||
my $c = shift;
|
||||
my $file = "data/myapi.json";
|
||||
my $j = JSON::XS->new->pretty->canonical->indent (1);
|
||||
my $json = $j->encode ($c);
|
||||
$j = undef; undef $j;
|
||||
use bytes;
|
||||
my $len = length ($json);
|
||||
no bytes;
|
||||
# TODO: make it transactional
|
||||
sysopen (C, $file, O_WRONLY|O_CREAT|O_TRUNC) or die "[FATA] Unable to open $file: $!\n";
|
||||
|
||||
my $written = syswrite (C, $json, $len);
|
||||
|
||||
unless (defined ($written)) {
|
||||
die "[FATA] Unable to write to $file: $!";
|
||||
}
|
||||
|
||||
unless ($written != $len) {
|
||||
die "[FATA] We wrote $written bytes to $file, bu buffer length id $len bytes\n";
|
||||
}
|
||||
|
||||
close C;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
149
lib/telegrambot.pm
Normal file
149
lib/telegrambot.pm
Normal file
@@ -0,0 +1,149 @@
|
||||
package telegrambot;
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
use vars qw/$VERSION/;
|
||||
use v5.10.0;
|
||||
use utf8;
|
||||
use open qw(:std :utf8);
|
||||
use File::Path qw( mkpath );
|
||||
use Hailo;
|
||||
use Encode;
|
||||
use Mojo::Base 'Telegram::Bot::Brain';
|
||||
|
||||
use conf;
|
||||
use botlib;
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT = qw(run_telegrambot);
|
||||
|
||||
$VERSION = "1.0";
|
||||
|
||||
my $c = loadConf();
|
||||
my $hailo;
|
||||
|
||||
has token => $c->{telegrambot}->{token};
|
||||
|
||||
sub __cron {
|
||||
my $self = shift;
|
||||
# noop
|
||||
return;
|
||||
}
|
||||
|
||||
sub __on_msg {
|
||||
my ($self, $msg) = @_;
|
||||
# lazy init chat-bot brains
|
||||
unless (defined($hailo->{$msg->chat->id})) {
|
||||
$hailo->{$msg->chat->id} = Hailo->new(
|
||||
# we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite
|
||||
brain => sprintf("%s/%s.brain.sqlite", $c->{telegrambot}->{braindir}, $msg->chat->id),
|
||||
order => 3
|
||||
);
|
||||
}
|
||||
|
||||
# is this a 1-on-1 ?
|
||||
if ($msg->chat->type eq 'private') {
|
||||
return unless(defined($msg->text));
|
||||
my $text = $msg->text;
|
||||
my $csign = quotemeta($c->{telegrambot}->{csign});
|
||||
my $reply;
|
||||
|
||||
if (substr($text, 0, 1) eq $c->{telegrambot}->{csign}) {
|
||||
if (substr($text, 1) eq "ping") {
|
||||
$reply = "Pong.";
|
||||
} elsif (substr($text, 1) eq "пинг") {
|
||||
$reply = "Понг.";
|
||||
} elsif (substr($text, 1, 1) eq 'w' || substr($text, 1, 1) eq 'п') {
|
||||
my $city = substr($text, 2);
|
||||
$reply = weather($city);
|
||||
} else {
|
||||
$reply = "Чего?";
|
||||
}
|
||||
} else {
|
||||
$reply = $hailo->{$msg->chat->id}->learn_reply($text);
|
||||
}
|
||||
|
||||
if (defined($reply) && $reply ne '') {
|
||||
$msg->reply($reply);
|
||||
} else {
|
||||
# if we have no answer, say something default in private chat
|
||||
$msg->reply("Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.");
|
||||
}
|
||||
# group chat
|
||||
} elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
|
||||
my $reply;
|
||||
return unless(defined($msg->text));
|
||||
my $text = $msg->text;
|
||||
# sometimes shit happens?
|
||||
return unless(defined($text));
|
||||
|
||||
my $qname = quotemeta($c->{telegrambot}->{name});
|
||||
my $qtname = quotemeta($c->{telegrambot}->{tname});
|
||||
my $csign = quotemeta($c->{telegrambot}->{csign});
|
||||
|
||||
# simple commands
|
||||
if (substr($text, 0, 1) eq $c->{telegrambot}->{csign}) {
|
||||
if (substr($text, 1) eq "ping") {
|
||||
$reply = "Pong.";
|
||||
} elsif (substr($text, 1) eq "пинг") {
|
||||
$reply = "Понг.";
|
||||
} elsif (substr($text, 1, 1) eq 'w' || substr($text, 1, 1) eq 'п') {
|
||||
my $city = substr($text, 2);
|
||||
$reply = weather($city);
|
||||
}
|
||||
} elsif (
|
||||
($text eq $qname) or
|
||||
($text eq sprintf("%s", $qtname)) or
|
||||
($text eq sprintf("@%s_bot", $qname)) or # :(
|
||||
($text eq sprintf("%s ", $qtname))
|
||||
) {
|
||||
$reply = "Чего?";
|
||||
} else {
|
||||
# phrase directed to bot
|
||||
if ((lc($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc($text) =~ /^${qtname}[\,|\:]? (.+)/)){
|
||||
$reply = $hailo->{$msg->chat->id}->learn_reply($1);
|
||||
# bot mention by name
|
||||
} elsif ((lc($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc($text) =~ / $qname$/)) {
|
||||
$reply = $hailo->{$msg->chat->id}->reply($text);
|
||||
# bot mention by telegram name
|
||||
} elsif ((lc($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc($text) =~ / $qtname$/)) {
|
||||
$reply = $hailo->{$msg->chat->id}->reply($text);
|
||||
# just message in chat
|
||||
} else {
|
||||
$hailo->{$msg->chat->id}->learn($text);
|
||||
}
|
||||
}
|
||||
|
||||
if (defined($reply) && $reply ne '') {
|
||||
$msg->reply($reply);
|
||||
}
|
||||
# should be channel, so we can't talk
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# setup our bot
|
||||
sub init {
|
||||
unless (-d $c->{telegrambot}->{braindir}) {
|
||||
mkpath ($c->{telegrambot}->{braindir}, 0, 0755);
|
||||
}
|
||||
|
||||
my $self = shift;
|
||||
$self->add_listener(\&__on_msg);
|
||||
# $self->add_repeating_task(900, \&__cron);
|
||||
}
|
||||
|
||||
sub run_telegrambot {
|
||||
while (sleep 3) {
|
||||
eval {
|
||||
telegrambot->new->think;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
Reference in New Issue
Block a user