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

91
.perlcriticrc Normal file
View File

@@ -0,0 +1,91 @@
#!/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 ofcorse 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 recomended 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 care, 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 enugh 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

45
bin/aleesa-jabber-bot
View File

@@ -2,16 +2,19 @@
use 5.018; use 5.018;
use strict; use strict;
use warnings "all"; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw(:std :utf8);
use English qw( -no_match_vars );
use version; our $VERSION = qw(1.0);
my $workdir; my $workdir;
# before we run, change working dir # before we run, change working dir
BEGIN { BEGIN {
use Cwd qw(chdir abs_path); use Cwd qw(chdir abs_path);
my @CWD = split (/\//, abs_path ($0)); my @CWD = split (/\//, abs_path ($PROGRAM_NAME));
if ($#CWD > 1) { $#CWD = $#CWD - 2; } if ($#CWD > 1) { $#CWD = $#CWD - 2; }
$workdir = join ('/', @CWD); $workdir = join ('/', @CWD);
chdir ($workdir); chdir ($workdir);
@@ -30,14 +33,14 @@ use jabberbot qw(run_jabberbot);
sub daemonize (); sub daemonize ();
sub __fork (); sub __fork ();
$| = 1; local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $<; my $runAsUid = $UID;
my $piddir = "/var/run/" . basename (abs_path ($0)); my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
my $C = loadConf (); my $C = loadConf ();
# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined # if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
if ($< == 0) { if ($UID == 0) {
my $user = $C->{user}; my $user = $C->{user};
die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined ($user)); die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined ($user));
my ($uid, $gid) = (getpwnam ($user))[2,3]; my ($uid, $gid) = (getpwnam ($user))[2,3];
@@ -63,8 +66,8 @@ if ($< == 0) {
} }
# drop privs # drop privs
setgid ($gid) or die "Unable to switch to group of $user($!)\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($!)\n"; setuid ($uid) or die "Unable to switch to account $user($OS_ERROR)\n";
} else { } else {
$piddir = $workdir; $piddir = $workdir;
} }
@@ -73,21 +76,21 @@ if ($< == 0) {
daemonize (); daemonize ();
# write pidfile # write pidfile
my $apath = abs_path ($0); my $apath = abs_path ($PROGRAM_NAME);
unless (defined($apath)) { unless (defined($apath)) {
logger ("Unable to get abs_path: $!"); logger ("Unable to get abs_path: $OS_ERROR");
die "Unable to get abs_path: $!\n"; die "Unable to get abs_path: $OS_ERROR\n";
}; };
my $pidfile = sprintf ("%s/%s.pid", $piddir, basename ($apath)); my $pidfile = sprintf ('%s/%s.pid', $piddir, basename ($apath));
logger ("Creating pidfile at $pidfile"); logger ("Creating pidfile at $pidfile");
open (PID, ">", $pidfile) or die "Error opening $pidfile: $!\n"; open (my $pid, '>', $pidfile) or die "Error opening $pidfile: $OS_ERROR\n";
print PID $$ or die "Error writing to $pidfile: $!\n"; print $pid $PID or die "Error writing to $pidfile: $OS_ERROR\n";
close PID; close $pid; ## no critic (InputOutput::RequireCheckedSyscalls
# set correct proctitle # set correct proctitle
$0 = abs_path ($0); $PROGRAM_NAME = abs_path ($PROGRAM_NAME); ## no critic (Variables::RequireLocalizedPunctuationVars)
# run bot, at last # run bot, at last
run_jabberbot (); run_jabberbot ();
@@ -97,17 +100,19 @@ exit 0;
sub daemonize () { sub daemonize () {
__fork (); __fork ();
POSIX::setsid (); POSIX::setsid ();
open (STDIN, "<", "/dev/null"); open (STDIN, '<', '/dev/null'); ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
open (STDOUT, ">", "/dev/null"); open (STDOUT, '>', '/dev/null'); ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
open (STDERR, ">", "/dev/null"); open (STDERR, '>', '/dev/null'); ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
__fork (); __fork ();
umask 0; umask 0;
return;
} }
sub __fork () { sub __fork () {
my $pid = fork; my $pid = fork;
die "Can't fork: $!\n" unless (defined ($pid)); die "Can't fork: $OS_ERROR\n" unless (defined ($pid));
exit if ($pid != 0); exit if ($pid != 0);
return;
} }
__END__ __END__

27
confcheck.pl
View File

@@ -2,34 +2,35 @@
use 5.018; use 5.018;
use strict; use strict;
use warnings "all"; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw(:std :utf8);
use English qw( -no_match_vars );
use lib ("./lib", "./vendor_perl", "./vendor_perl/lib/perl5"); use lib qw(./lib ./vendor_perl ./vendor_perl/lib/perl5);
use JSON::PP; use JSON::PP;
my $c = "data/config.json"; use version; our $VERSION = qv(1.0);
open (C, "<", $c) or die "No conf at $c: $!\n";
my $c = 'data/config.json';
open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n"; ## no critic (InputOutput::RequireBriefOpen)
my $len = (stat ($c)) [7]; my $len = (stat ($c)) [7];
my $json; my $json;
my $readlen = read (C, $json, $len); my $readlen = read ($C, $json, $len);
unless ($readlen) { unless ($readlen) {
close C; close C; ## no critic (InputOutput::RequireCheckedSyscalls)
die "Unable to read $c: $!\n"; die "Unable to read $c: $OS_ERROR\n";
} }
if ($readlen != $len) { if ($readlen != $len) {
close C; close C; ## no critic (InputOutput::RequireCheckedSyscalls)
die "File $c is $len bytes on disk, but we read only $readlen bytes\n"; die "File $c is $len bytes on disk, but we read only $readlen bytes\n";
} }
close C; close C; ## no critic (InputOutput::RequireCheckedSyscalls)
$c = decode_json ($json); $c = decode_json ($json);
my $j = JSON::PP->new->pretty->canonical->indent_length (4); my $j = JSON::PP->new->pretty->canonical->indent_length (4); ## no critic (ValuesAndExpressions::ProhibitLongChainsOfMethodCalls)
print $j->encode ($c); print $j->encode ($c); ## no critic (InputOutput::RequireCheckedSyscalls)
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

81
lib/botlib.pm
View File

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

54
lib/conf.pm
View File

@@ -1,69 +1,43 @@
package conf; package conf;
# loads config
use 5.018; use 5.018;
use strict; use strict;
use warnings "all"; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw(:std :utf8);
use English qw( -no_match_vars );
use vars qw/$VERSION/; use vars qw/$VERSION/;
use Fcntl qw(O_WRONLY O_CREAT O_TRUNC); use JSON::XS;
use JSON::XS qw(decode_json encode_json);
use Exporter qw(import); use Exporter qw(import);
our @EXPORT = qw(loadConf saveConf); our @EXPORT_OK = qw(loadConf);
$VERSION = "1.0"; $VERSION = '1.0';
sub loadConf ();
sub saveConf ($);
sub loadConf () { sub loadConf {
my $c = "data/config.json"; my $c = 'data/config.json';
open (C, "<", $c) or die "[FATA] No conf at $c: $!\n"; open my $CH, '<', $c or die "[FATA] No conf at $c: $OS_ERROR\n";
my $len = (stat ($c)) [7]; my $len = (stat ($c)) [7];
my $json; my $json;
my $readlen = read (C, $json, $len); my $readlen = read $CH, $json, $len;
unless ($readlen) { unless ($readlen) {
close C; close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATA] Unable to read $c: $!\n"; die "[FATA] Unable to read $c: $OS_ERROR\n";
} }
if ($readlen != $len) { 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"; 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; my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($json); 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; 1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: # 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 5.018;
use strict; use strict;
use warnings "all"; use warnings;
use utf8; use utf8;
use open qw(:std :utf8); use open qw(:std :utf8);
use Net::Jabber::Bot; use Net::Jabber::Bot;
use Hailo; use Hailo;
use conf; use conf qw(loadConf);
use botlib; use botlib qw(weather logger trim randomCommonPhrase);
use Exporter qw(import); use Exporter qw(import);
use vars qw/$VERSION/; use vars qw/$VERSION/;
$VERSION = "1.0"; $VERSION = '1.0';
our @EXPORT = qw(run_jabberbot); our @EXPORT_OK = qw(run_jabberbot);
my $c = loadConf(); my $c = loadConf();
my $hailo; my $hailo;
@@ -41,66 +41,66 @@ sub __new_bot_message {
# my $text = encode('utf-8', $hash{body}); # my $text = encode('utf-8', $hash{body});
my $text = $hash{body}; my $text = $hash{body};
if ($hash{'type'} eq "groupchat") { if ($hash{'type'} eq 'groupchat') {
# ignore self messages # ignore self messages
return if ($hash{'from_full'} eq $bot->{'from_full'}); return if ($hash{'from_full'} eq $bot->{'from_full'});
# parse messages # parse messages
my $qname = quotemeta($c->{jabberbot}->{aleesa}->{mucname}); my $qname = quotemeta($c->{jabberbot}->{aleesa}->{mucname});
if ($text =~ /^$qname$/) { if ($text =~ /^$qname$/) {
$bot->SendGroupMessage($hash{'reply_to'}, "Чего тебе?"); $bot->SendGroupMessage($hash{'reply_to'}, 'Чего тебе?');
} elsif ($text =~ /^$qname[\,|\:]? (.+)/) { } elsif ($text =~ /^$qname[\,|\:]? (.+)/) {
# $bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply(decode('utf-8', $1))); # $bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply(decode('utf-8', $1)));
$bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply($1)); $bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply($1));
} elsif ($text eq "$c->{jabberbot}->{aleesa}->{csign}пинг") { } 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") { } 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}) { } elsif (substr($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
# $text = decode('utf-8', $text); # $text = decode('utf-8', $text);
if (substr($text, 1, 3) eq "rum") { if (substr($text, 1, 3) eq 'rum') {
eval { eval {
$bot->SendGroupMessage( $bot->SendGroupMessage(
$hash{'reply_to'}, $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 { eval {
$bot->SendGroupMessage( $bot->SendGroupMessage(
$hash{'reply_to'}, $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 { eval {
$bot->SendGroupMessage( $bot->SendGroupMessage(
$hash{'reply_to'}, $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 { eval {
$bot->SendGroupMessage( $bot->SendGroupMessage(
$hash{'reply_to'}, $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 { eval {
$bot->SendGroupMessage( $bot->SendGroupMessage(
$hash{'reply_to'}, $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 { eval {
$bot->SendGroupMessage( $bot->SendGroupMessage(
$hash{'reply_to'}, $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); my $city = substr($text, 2);
eval { eval {
@@ -117,8 +117,8 @@ sub __new_bot_message {
#$hailo->learn($text); #$hailo->learn($text);
return; return;
} }
} elsif ($hash{'type'} eq "chat") { } elsif ($hash{'type'} eq 'chat') {
$bot->SendPersonalMessage($hash{'reply_to'}, "Я вас не знаю, идите нахуй."); $bot->SendPersonalMessage($hash{'reply_to'}, 'Я вас не знаю, идите нахуй.');
return; return;
} }
@@ -165,6 +165,8 @@ sub run_jabberbot {
$bot->Start(); $bot->Start();
}; };
} }
return;
} }
1; 1;