Implement !dig and !копать commands, fix typo in help message
This commit is contained in:
eleksir
101
lib/archeologist.pm
Normal file
101
lib/archeologist.pm
Normal file
@@ -0,0 +1,101 @@
|
||||
package archeologist;
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw(:std :utf8);
|
||||
use English qw( -no_match_vars );
|
||||
|
||||
use vars qw/$VERSION/;
|
||||
use Exporter qw(import);
|
||||
our @EXPORT_OK = qw(dig);
|
||||
$VERSION = '1.0';
|
||||
|
||||
sub dig {
|
||||
my $name = shift;
|
||||
|
||||
my @artifact = (
|
||||
'амулет Мерлина',
|
||||
'библиотеку Ивана Грозного',
|
||||
'деревянную плошку',
|
||||
'диплока',
|
||||
'доски Ноева Ковчега',
|
||||
'древний презерватив из бараньей кишки',
|
||||
'икону',
|
||||
'инсталятор Windows 3.11',
|
||||
'истлевший гроб',
|
||||
'каменный топор',
|
||||
'клад со златом-серебром',
|
||||
'кривой нож',
|
||||
'ледяную глыбу',
|
||||
'лунный грунт',
|
||||
'мамонта',
|
||||
'мамонтенка',
|
||||
'метеорит',
|
||||
'мумию фараона Тутанхамона',
|
||||
'носки прапорщика (поставит в угол)',
|
||||
'обломки грузинской керамики',
|
||||
'птеродактиля',
|
||||
'рубль с Лениным',
|
||||
'рыцарские доспехи',
|
||||
'синий мох',
|
||||
'скелет',
|
||||
'скелет собаки по кличке Беня',
|
||||
'тиранозавтра',
|
||||
'тотем индейцев',
|
||||
'трубу с туркменским газом',
|
||||
);
|
||||
|
||||
my @location = (
|
||||
'в архивах',
|
||||
'в гималаях',
|
||||
'в интернете',
|
||||
'в кармане',
|
||||
'в клумбе',
|
||||
'в лунном кратере',
|
||||
'во льдах арктики',
|
||||
'в морге',
|
||||
'в окрестностях погоста',
|
||||
'в песочнице',
|
||||
'в пустыне Гоби',
|
||||
'в пустыне Сахаре',
|
||||
'в русле высохшей реки',
|
||||
'в собственной памяти',
|
||||
'в старом сортире',
|
||||
'в углу',
|
||||
'в цветочном горшке',
|
||||
'на бабушкином огороде',
|
||||
'на винчестере',
|
||||
'на горе Арарат',
|
||||
'на горном плато',
|
||||
'на дне моря',
|
||||
'на необитаемом острове',
|
||||
'на первом слое сумрака',
|
||||
'на просторах Украины',
|
||||
);
|
||||
|
||||
my $find_probability = int (rand 100);
|
||||
my $success_probability = int (rand 100);
|
||||
my $artifact_age = int (rand 15000);
|
||||
|
||||
if ($find_probability < 15) {
|
||||
return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[int (rand ($#location + 1))], $name;
|
||||
}
|
||||
|
||||
my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[int (rand ($#location + 1))];
|
||||
$phrase .= "Вам кажется что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n";
|
||||
|
||||
if ($success_probability < 5) {
|
||||
$phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact[int (rand ($#artifact + 1))], $artifact_age;
|
||||
} else {
|
||||
$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[int (rand ($#artifact + 1))], $artifact_age;
|
||||
$phrase .= sprintf 'Извини %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name;
|
||||
}
|
||||
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
@@ -18,6 +18,7 @@ use lat qw(latAnswer);
|
||||
use karma qw(karmaSet karmaGet);
|
||||
use friday qw(friday);
|
||||
use fortune qw(fortune fortune_toggle fortune_status);
|
||||
use archeologist qw (dig);
|
||||
|
||||
use vars qw/$VERSION/;
|
||||
use Exporter qw(import);
|
||||
@@ -227,9 +228,37 @@ sub randomCommonPhrase {
|
||||
}
|
||||
|
||||
sub command {
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
my $text = shift;
|
||||
my $chatid = shift;
|
||||
my $reply;
|
||||
my $fullname;
|
||||
my $highlight;
|
||||
my $username;
|
||||
my $userid = $msg->from->id;
|
||||
$username = $msg->from->username if ($msg->from->can ('username') && defined($msg->from->username));
|
||||
|
||||
if ($msg->from->can ('first_name') && defined ($msg->from->first_name)) {
|
||||
$fullname = $msg->from->first_name;
|
||||
|
||||
if ($msg->from->can ('last_name') && defined ($msg->from->last_name)) {
|
||||
$fullname .= ' ' . $msg->from->last_name;
|
||||
}
|
||||
} elsif ($msg->from->can ('last_name') && defined ($msg->from->last_name)) {
|
||||
$fullname .= $msg->from->last_name;
|
||||
}
|
||||
|
||||
if (defined ($username)) {
|
||||
if (defined ($fullname)) {
|
||||
$highlight = "[$fullname](tg://user?id=$userid)";
|
||||
} else {
|
||||
$highlight = "[$username](tg://user?id=$userid)";
|
||||
}
|
||||
} else {
|
||||
$highlight = "[$fullname](tg://user?id=$userid)";
|
||||
}
|
||||
|
||||
|
||||
if (substr ($text, 1) eq 'ping') {
|
||||
$reply = 'Pong.';
|
||||
@@ -268,6 +297,12 @@ sub command {
|
||||
$reply = fortune_toggle ($chatid, 0);
|
||||
} elsif (substr ($text, 1) eq 'f ?' || substr ($text, 1) eq 'fortune ?' || substr ($text, 1) eq 'фортунка ?' || substr ($text, 1) eq 'ф ?') {
|
||||
$reply = fortune_status ($chatid);
|
||||
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
|
||||
my $send_args;
|
||||
$send_args->{text} = dig ($highlight);
|
||||
$send_args->{parse_mode} = 'Markdown';
|
||||
$send_args->{chat_id} = $msg->chat->id;
|
||||
Teapot::Bot::Brain::sendMessage ($self, $send_args);
|
||||
}
|
||||
|
||||
return $reply;
|
||||
|
||||
@@ -238,13 +238,14 @@ sub __on_msg {
|
||||
$send_args->{text} = << 'MYHELP';
|
||||
```
|
||||
!help | !помощь - список команд
|
||||
!dig | !копать - заняться археологией
|
||||
!f | !ф - рандомная фраза из сборника цитат fortune_mod
|
||||
!fortune | !фортунка - рандомная фраза из сборника цитат fortune_mod
|
||||
!f # | !ф # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!fortune # | !фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!f ? | !ф ? - показываем ли с утра фортунку для чата
|
||||
!fortune ? | !фортунка ? - показываем ли с утра фортунку для чата
|
||||
!friday | пятница - а не пятница ли сегодня?
|
||||
!friday | !пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!ping | !пинг - попинговать бота
|
||||
!ver | !version | !версия - что-то про версию ПО
|
||||
@@ -260,7 +261,7 @@ MYHELP
|
||||
Teapot::Bot::Brain::sendMessage ($self, $send_args);
|
||||
return;
|
||||
} else {
|
||||
$reply = command ($text, $userid);
|
||||
$reply = command ($self, $msg, $text, $userid);
|
||||
}
|
||||
} else {
|
||||
my $just_message_in_chat = 0;
|
||||
@@ -371,13 +372,14 @@ MYHELP
|
||||
$send_args->{text} = << 'MYHELP';
|
||||
```
|
||||
!help | !помощь - список команд
|
||||
!dig | !копать - заняться археологией
|
||||
!f | !ф - рандомная фраза из сборника цитат fortune_mod
|
||||
!fortune | !фортунка - рандомная фраза из сборника цитат fortune_mod
|
||||
!f # | !ф # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!fortune # | !фортунка # - где 1 - вкл, 0 - выкл фортунку с утра
|
||||
!f ? | !ф ? - показываем ли с утра фортунку для чата
|
||||
!fortune ? | !фортунка ? - показываем ли с утра фортунку для чата
|
||||
!friday | пятница - а не пятница ли сегодня?
|
||||
!friday | !пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатых латинских выражений
|
||||
!ping | !пинг - попинговать бота
|
||||
!ver | !version | !версия - что-то про версию ПО
|
||||
@@ -393,7 +395,7 @@ MYHELP
|
||||
Teapot::Bot::Brain::sendMessage ($self, $send_args);
|
||||
return;
|
||||
} else {
|
||||
$reply = command ($text, $chatid);
|
||||
$reply = command ($self, $msg, $text, $chatid);
|
||||
}
|
||||
} elsif (
|
||||
($text eq $qname) or
|
||||
|
||||
Reference in New Issue
Block a user