Compare commits
7 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
e823573534 | ||
|
|
ba69f9d9df | ||
|
|
4d9cde38be | ||
|
|
61ad8278d5 | ||
|
|
7ddd97710c | ||
|
|
1229199ddc | ||
|
|
5f31a10832 |
@@ -1,4 +1,5 @@
|
|||||||
#!/usr/bin/env perlcritic
|
#!/usr/bin/env perlcritic
|
||||||
|
|
||||||
# Задействованные модули критика:
|
# Задействованные модули критика:
|
||||||
#
|
#
|
||||||
# Perl::Critic::More
|
# Perl::Critic::More
|
||||||
@@ -9,6 +10,9 @@
|
|||||||
# Perl::Critic::Policy::CompileTime
|
# Perl::Critic::Policy::CompileTime
|
||||||
# Perl::Critic::Policy::ProhibitImplicitImport
|
# Perl::Critic::Policy::ProhibitImplicitImport
|
||||||
# Perl::Critic::Policy::Dynamic::NoIndirect
|
# Perl::Critic::Policy::Dynamic::NoIndirect
|
||||||
|
# Perl::Critic::StricterSubs
|
||||||
|
# Perl::Critic::Policy::ProhibitImplicitImport
|
||||||
|
# Perl::Critic::Policy::CodeLayout::RequireUseUTF8
|
||||||
|
|
||||||
[-ControlStructures::ProhibitUnlessBlocks]
|
[-ControlStructures::ProhibitUnlessBlocks]
|
||||||
# oh. c'mon. just a little bit
|
# oh. c'mon. just a little bit
|
||||||
|
|||||||
@@ -83,8 +83,8 @@ if ($UID == 0) {
|
|||||||
make_path (
|
make_path (
|
||||||
$logdir, {
|
$logdir, {
|
||||||
uid => $uid,
|
uid => $uid,
|
||||||
group => $gid
|
group => $gid,
|
||||||
}
|
},
|
||||||
) or die "Unable to create $logdir: $OS_ERROR\n";
|
) or die "Unable to create $logdir: $OS_ERROR\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -115,7 +115,7 @@ my $apath = abs_path $PROGRAM_NAME;
|
|||||||
unless (defined $apath) {
|
unless (defined $apath) {
|
||||||
$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
|
$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
|
||||||
exit 1;
|
exit 1;
|
||||||
};
|
}
|
||||||
|
|
||||||
my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
|
my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
|
||||||
$log->info ("[INFO] Creating pidfile at $pidfile");
|
$log->info ("[INFO] Creating pidfile at $pidfile");
|
||||||
|
|||||||
16
lib/Karma.pm
16
lib/Karma.pm
@@ -1,4 +1,5 @@
|
|||||||
package Karma;
|
package Karma;
|
||||||
|
# Хранит и выдаёт карму фразы
|
||||||
|
|
||||||
use 5.018; ## no critic (ProhibitImplicitImport)
|
use 5.018; ## no critic (ProhibitImplicitImport)
|
||||||
use strict;
|
use strict;
|
||||||
@@ -22,15 +23,19 @@ my $c = LoadConf ();
|
|||||||
my $cachedir = $c->{cachedir};
|
my $cachedir = $c->{cachedir};
|
||||||
my $max = 5;
|
my $max = 5;
|
||||||
|
|
||||||
# swallow phrase and return answer
|
|
||||||
sub KarmaSet (@) {
|
sub KarmaSet (@) {
|
||||||
my $chatid = shift;
|
my $chatid = shift;
|
||||||
my $phrase = shift;
|
my $phrase = shift;
|
||||||
my $action = shift;
|
my $action = shift;
|
||||||
|
|
||||||
|
unless (defined $phrase) {
|
||||||
|
$phrase = '';
|
||||||
|
}
|
||||||
|
|
||||||
$phrase = trim ($phrase);
|
$phrase = trim ($phrase);
|
||||||
|
|
||||||
if ((! defined $phrase) || $phrase eq '') {
|
# Костылёк для кармы пустоты
|
||||||
|
if ($phrase eq '') {
|
||||||
$phrase = ' ';
|
$phrase = ' ';
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -80,9 +85,14 @@ sub KarmaGet (@) {
|
|||||||
my $chatid = shift;
|
my $chatid = shift;
|
||||||
my $phrase = shift;
|
my $phrase = shift;
|
||||||
|
|
||||||
|
unless (defined $phrase) {
|
||||||
|
$phrase = '';
|
||||||
|
}
|
||||||
|
|
||||||
$phrase = trim ($phrase);
|
$phrase = trim ($phrase);
|
||||||
|
|
||||||
if ((! defined $phrase) || $phrase eq '') {
|
# Костылёк для кармы пустоты
|
||||||
|
if ($phrase eq '') {
|
||||||
$phrase = ' ';
|
$phrase = ' ';
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -67,11 +67,14 @@ my $parse_message = sub {
|
|||||||
$answer->{misc}->{msg_format} = 0;
|
$answer->{misc}->{msg_format} = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
$answer->{userid} = 0 + $m->{userid};
|
||||||
|
$answer->{chatid} = 0 + $m->{chatid};
|
||||||
|
|
||||||
$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
|
$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
|
||||||
|
|
||||||
# Нормальная команда
|
# Нормальная команда
|
||||||
if (substr ($m->{message}, 0, 1) eq $answer->{misc}->{csign}) {
|
if (substr ($m->{message}, 0, length ($answer->{misc}->{csign})) eq $answer->{misc}->{csign}) {
|
||||||
my $cmd = substr ($m->{message}, 1);
|
my $cmd = substr $m->{message}, length ($answer->{misc}->{csign});
|
||||||
|
|
||||||
if ($cmd eq 'friday' || $cmd eq 'пятница') {
|
if ($cmd eq 'friday' || $cmd eq 'пятница') {
|
||||||
$reply = Friday ();
|
$reply = Friday ();
|
||||||
@@ -94,36 +97,60 @@ my $parse_message = sub {
|
|||||||
} else {
|
} else {
|
||||||
$reply = trim (Fortune ());
|
$reply = trim (Fortune ());
|
||||||
}
|
}
|
||||||
} elsif ($cmd =~ /^(karma|карма)\s(.+)/su) {
|
} elsif (length ($cmd) >= length ('karma ') && substr ($cmd, 0, length ('karma ')) eq 'karma ') {
|
||||||
# TODO: избавиться от регулярки в пользу манипуляци со строкой через substr
|
# По-умолчанию достаём карму пустоты
|
||||||
$reply = KarmaGet ($m->{chatid}, $2);
|
my $text = undef;
|
||||||
|
|
||||||
|
if (length ($cmd) > length ('karma ')) {
|
||||||
|
$text = substr $cmd, length ('karma ');
|
||||||
|
}
|
||||||
|
|
||||||
|
$reply = KarmaGet ($m->{chatid}, $text);
|
||||||
|
} elsif (length ($cmd) >= length ('карма ') && substr ($cmd, 0, length ('карма ')) eq 'карма ') {
|
||||||
|
# По-умолчанию достаём карму пустоты
|
||||||
|
my $text = undef;
|
||||||
|
|
||||||
|
if (length ($cmd) > length ('карма ')) {
|
||||||
|
$text = substr $cmd, length ('карма ');
|
||||||
|
}
|
||||||
|
|
||||||
|
$reply = KarmaGet ($m->{chatid}, $text);
|
||||||
|
# Достаём карму пустоты :)
|
||||||
|
} elsif ($cmd eq 'karma') {
|
||||||
|
$reply = KarmaGet ($m->{chatid}, undef);
|
||||||
|
# Достаём карму пустоты :)
|
||||||
|
}elsif ($cmd eq 'карма') {
|
||||||
|
$reply = KarmaGet ($m->{chatid}, undef);
|
||||||
}
|
}
|
||||||
# Скорее всего изменение кармы, но это не точно
|
# Скорее всего изменение кармы, но это не точно
|
||||||
} elsif (substr ($m->{message}, -2) eq '++' || substr ($m->{message}, -2) eq '--') {
|
} elsif (length ($m->{message}) > length ('++')) {
|
||||||
my @arr = split /\n/s, $m->{message};
|
if (substr ($m->{message}, 0 - length ('++')) eq '++' || substr ($m->{message}, 0 - length ('--')) eq '--') {
|
||||||
|
my @arr = split /\n/s, $m->{message};
|
||||||
|
|
||||||
# Предполагается, что фраза - это только одна строка
|
# Предполагается, что фраза - это только одна строка
|
||||||
if ($#arr < 1) {
|
if ($#arr < 1) {
|
||||||
$reply = KarmaSet (
|
$reply = KarmaSet (
|
||||||
$m->{chatid},
|
$m->{chatid},
|
||||||
trim (substr $m->{message}, 0, -2),
|
trim (substr $m->{message}, 0, 0 - length ('++')),
|
||||||
substr $m->{message}, -2,
|
substr $m->{message}, 0 - length ('++'),
|
||||||
);
|
);
|
||||||
# Если у нас более одной строки - пусть с этим разбирается craniac, у него есть *мозги*
|
# Если у нас более одной строки - пусть с этим разбирается craniac, у него есть *мозги*
|
||||||
} else {
|
} else {
|
||||||
$send_to = 'craniac';
|
$send_to = 'craniac';
|
||||||
$reply = $m->{message};
|
$reply = $m->{message};
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));
|
|
||||||
|
|
||||||
if (defined $reply && $answer->{misc}->{answer}) {
|
if (defined $reply && $answer->{misc}->{answer}) {
|
||||||
$answer->{message} = $reply;
|
$answer->{message} = $reply;
|
||||||
|
$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));
|
||||||
|
|
||||||
$self->json ($send_to)->notify (
|
$self->json ($send_to)->notify (
|
||||||
$send_to => $answer,
|
$send_to => $answer,
|
||||||
);
|
);
|
||||||
|
} else {
|
||||||
|
$log->debug ('[DEBUG] No reply generated, skip sending message.');
|
||||||
}
|
}
|
||||||
|
|
||||||
return;
|
return;
|
||||||
|
|||||||
Reference in New Issue
Block a user