eleksir/aleesa-jabber-bot
1
Fork 0
Code Activity

Use perlcritic to lint code

Browse Source
This commit is contained in:
eleksir
2020-11-14 13:51:17 +03:00
parent 1780c94ede
commit 7443882c84
6 changed files with 212 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
lib/botlib.pm
View File

@@ -2,10 +2,11 @@ package botlib;
use 5.018;
use strict;
use warnings "all";
use warnings;
use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use Carp qw(carp);
use HTTP::Tiny;
use URI::URL;
use JSON::XS qw(decode_json encode_json);
@@ -17,21 +18,21 @@ use conf qw(loadConf);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT = qw(weather logger trim randomCommonPhrase);
our @EXPORT_OK = qw(weather logger trim randomCommonPhrase);
$VERSION = "1.0";
$VERSION = '1.0';
my $c = loadConf();
my $c = loadConf ();
sub weather($) {
sub weather ($) {
my $city = shift;
$city = trim($city);
$city = trim ($city);
return "Мне нужно ИМЯ города." if ($city eq '');
return "Длинновато для названия города." if (length($city) > 80);
return 'Мне нужно ИМЯ города.' if ($city eq '');
return 'Длинновато для названия города.' if (length ($city) > 80);
$city = ucfirst($city);
my $w = __weather($city);
$city = ucfirst ($city);
my $w = __weather ($city);
my $reply;
if ($w) {
@@ -39,7 +40,7 @@ sub weather($) {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name},
$w->{country},
ucfirst($w->{description}),
ucfirst ($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
@@ -51,7 +52,7 @@ sub weather($) {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name},
$w->{country},
ucfirst($w->{description}),
ucfirst ($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
@@ -68,23 +69,23 @@ sub weather($) {
return $reply;
}
sub __weather($) {
sub __weather ($) {
my $city = shift;
$city = __urlencode($city);
my $id = md5_base64($city);
$city = __urlencode ($city);
my $id = md5_base64 ($city);
my $appid = $c->{openweathermap}->{appid};
my $now = time();
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: $!";
carp "Something nasty happen when cachetime ties to its data: $OS_ERROR";
return undef;
};
tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do {
warn "Something nasty happen when cachedata ties to its data: $!";
carp "Something nasty happen when cachedata ties to its data: $OS_ERROR";
return undef;
};
@@ -95,10 +96,10 @@ sub __weather($) {
my $r;
# try 3 times and giveup
for (my $counter = 0; $counter < 3; $counter++) {
for (1..3) {
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));
$r = $http->get(sprintf('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid));
sleep 2;
}
@@ -106,8 +107,8 @@ sub __weather($) {
if ($r->{success}) {
$fc = eval { decode_json($r->{content}) };
if ($@) {
warn "[WARN] openweathermap returns corrupted json: $@";
if ($EVAL_ERROR) {
carp "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
untie %cachetime;
untie %cachedata;
return undef;
@@ -195,14 +196,16 @@ sub logger {
my $mode = '>';
$mode = '>>' if (-f $c->{debug_log});
if (open (LOG, $mode, $c->{debug_log})) {
print LOG $msg . "\n";
close LOG;
if (open (my $LOG, $mode, $c->{debug_log})) {
print $LOG $msg . "\n"; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
close $LOG; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
}
}
return;
}
sub trim($) {
sub trim ($) {
my $str = shift;
while (substr ($str, 0, 1) =~ /^\s$/) {
@@ -216,21 +219,21 @@ sub trim($) {
return $str;
}
sub randomCommonPhrase() {
sub randomCommonPhrase () {
my @myphrase = (
"Так, блядь...",
"*Закатывает рукава* И ради этого ты меня позвал?",
"Ну чего ты начинаешь, нормально же общались",
"Повтори свой вопрос, не поняла",
"Выйди и зайди нормально",
"Я подумаю",
"Даже не знаю что на это ответить",
"Ты упал такие вопросы девочке задавать?",
"Можно и так, но не уверена",
"А как ты думаешь?"
'Так, блядь...',
'*Закатывает рукава* И ради этого ты меня позвал?',
'Ну чего ты начинаешь, нормально же общались',
'Повтори свой вопрос, не поняла',
'Выйди и зайди нормально',
'Я подумаю',
'Даже не знаю что на это ответить',
'Ты упал такие вопросы девочке задавать?',
'Можно и так, но не уверена',
'А как ты думаешь?',
);
return ($myphrase[rand($#myphrase -1)]);
return $myphrase[rand($#myphrase -1)];
}
1;

54
lib/conf.pm
View File

@@ -1,69 +1,43 @@
package conf;
# loads config
use 5.018;
use strict;
use warnings "all";
use warnings;
use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use vars qw/$VERSION/;
use Fcntl qw(O_WRONLY O_CREAT O_TRUNC);
use JSON::XS qw(decode_json encode_json);
use JSON::XS;
use Exporter qw(import);
our @EXPORT = qw(loadConf saveConf);
our @EXPORT_OK = qw(loadConf);
$VERSION = "1.0";
sub loadConf ();
sub saveConf ($);
$VERSION = '1.0';
sub loadConf () {
my $c = "data/config.json";
open (C, "<", $c) or die "[FATA] No conf at $c: $!\n";
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 (C, $json, $len);
my $readlen = read $CH, $json, $len;
unless ($readlen) {
close C;
die "[FATA] Unable to read $c: $!\n";
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATA] Unable to read $c: $OS_ERROR\n";
}
if ($readlen != $len) {
close C;
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n";
}
close C;
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($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:

50
lib/jabberbot.pm
View File

@@ -5,20 +5,20 @@ package jabberbot;
use 5.018;
use strict;
use warnings "all";
use warnings;
use utf8;
use open qw(:std :utf8);
use Net::Jabber::Bot;
use Hailo;
use conf;
use botlib;
use conf qw(loadConf);
use botlib qw(weather logger trim randomCommonPhrase);
use Exporter qw(import);
use vars qw/$VERSION/;
$VERSION = "1.0";
our @EXPORT = qw(run_jabberbot);
$VERSION = '1.0';
our @EXPORT_OK = qw(run_jabberbot);
my $c = loadConf();
my $hailo;
@@ -41,66 +41,66 @@ sub __new_bot_message {
# my $text = encode('utf-8', $hash{body});
my $text = $hash{body};
if ($hash{'type'} eq "groupchat") {
if ($hash{'type'} eq 'groupchat') {
# ignore self messages
return if ($hash{'from_full'} eq $bot->{'from_full'});
# parse messages
my $qname = quotemeta($c->{jabberbot}->{aleesa}->{mucname});
if ($text =~ /^$qname$/) {
$bot->SendGroupMessage($hash{'reply_to'}, "Чего тебе?");
$bot->SendGroupMessage($hash{'reply_to'}, 'Чего тебе?');
} elsif ($text =~ /^$qname[\,|\:]? (.+)/) {
# $bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply(decode('utf-8', $1)));
$bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply($1));
} elsif ($text eq "$c->{jabberbot}->{aleesa}->{csign}пинг") {
$bot->SendGroupMessage($hash{'reply_to'}, "Понг.");
$bot->SendGroupMessage($hash{'reply_to'}, 'Понг.');
} elsif ($text eq "$c->{jabberbot}->{aleesa}->{csign}ping") {
$bot->SendGroupMessage($hash{'reply_to'}, "Pong.");
$bot->SendGroupMessage($hash{'reply_to'}, 'Pong.');
} elsif (substr($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
# $text = decode('utf-8', $text);
if (substr($text, 1, 3) eq "rum") {
if (substr($text, 1, 3) eq 'rum') {
eval {
$bot->SendGroupMessage(
$hash{'reply_to'},
"/me притаскивает на подносе стопку рома для ". (split(/\//,$hash{from_full}))[1] . ", края стопки искрятся кристаллами соли."
'/me притаскивает на подносе стопку рома для ' . (split(/\//,$hash{from_full}))[1] . ', края стопки искрятся кристаллами соли.'
);
};
} elsif (substr($text, 1, 5) eq "vodka") {
} elsif (substr($text, 1, 5) eq 'vodka') {
eval {
$bot->SendGroupMessage(
$hash{'reply_to'},
"/me подаёт водку с маринованным огурчиком для " . (split(/\//,$hash{from_full}))[1]
'/me подаёт водку с маринованным огурчиком для ' . (split(/\//,$hash{from_full}))[1]
);
};
} elsif (substr($text, 1, 4) eq "beer") {
} elsif (substr($text, 1, 4) eq 'beer') {
eval {
$bot->SendGroupMessage(
$hash{'reply_to'},
"/me бахает об стол перед " . (split(/\//,$hash{from_full}))[1] . " кружкой холодного пива, часть пенной шапки сползает по запотевшей спенке кружки."
'/me бахает об стол перед ' . (split(/\//,$hash{from_full}))[1] . ' кружкой холодного пива, часть пенной шапки сползает по запотевшей спенке кружки.'
);
};
} elsif (substr($text, 1, 7) eq "tequila") {
} elsif (substr($text, 1, 7) eq 'tequila') {
eval {
$bot->SendGroupMessage(
$hash{'reply_to'},
"/me ставит рядом с " . (split(/\//,$hash{from_full}))[1] . " шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли."
'/me ставит рядом с ' . (split(/\//,$hash{from_full}))[1] . ' шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли.'
);
};
} elsif (substr($text, 1, 6) eq "whisky") {
} elsif (substr($text, 1, 6) eq 'whisky') {
eval {
$bot->SendGroupMessage(
$hash{'reply_to'},
"/me демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около " . (split(/\//,$hash{from_full}))[1] . "."
'/me демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около ' . (split(/\//,$hash{from_full}))[1] . '.'
);
};
} elsif (substr($text, 1, 8) eq "absinthe") {
} elsif (substr($text, 1, 8) eq 'absinthe') {
eval {
$bot->SendGroupMessage(
$hash{'reply_to'},
"/me наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, $c->{jabberbot}->{aleesa}->{mucname} размешивает оплавившийся кубик в абсенте и подносит стопку " .(split(/\//,$hash{from_full}))[1] . "."
"/me наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, $c->{jabberbot}->{aleesa}->{mucname} размешивает оплавившийся кубик в абсенте и подносит стопку " .(split(/\//,$hash{from_full}))[1] . '.'
);
};
} elsif ((substr($text, 1, 2) eq "w ") || (substr($text, 1, 2) eq "п ")) {
} elsif ((substr($text, 1, 2) eq 'w ') || (substr($text, 1, 2) eq 'п ')) {
my $city = substr($text, 2);
eval {
@@ -117,8 +117,8 @@ sub __new_bot_message {
#$hailo->learn($text);
return;
}
} elsif ($hash{'type'} eq "chat") {
$bot->SendPersonalMessage($hash{'reply_to'}, "Я вас не знаю, идите нахуй.");
} elsif ($hash{'type'} eq 'chat') {
$bot->SendPersonalMessage($hash{'reply_to'}, 'Я вас не знаю, идите нахуй.');
return;
}
@@ -165,6 +165,8 @@ sub run_jabberbot {
$bot->Start();
};
}
return;
}
1;