aleesa-bot/aleesa-telegram
0
Fork 0
Code Pull Requests Projects Releases Activity

Move Archeologist and Fisher to separate module

Browse Source
This commit is contained in:
eleksir
2022-01-07 16:53:32 +03:00
parent ca946c7e7b
commit 3a061078d4
7 changed files with 12 additions and 487 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
lib/BotLib.pm
View File

@@ -16,8 +16,6 @@ use BotLib::Conf qw (LoadConf);
use BotLib::Admin qw (@ForbiddenMessageTypes GetForbiddenTypes AddForbiddenType
DelForbiddenType ListForbidden FortuneToggle FortuneStatus
PluginToggle PluginStatus PluginEnabled ChanMsgToggle ChanMsgStatus);
use BotLib::Archeologist qw (Dig);
use BotLib::Fisher qw (Fish);
use BotLib::Util qw (trim);
use version; our $VERSION = qw (1.0);
@@ -75,7 +73,7 @@ sub Command {
@cmds = qw (ping пинг пинх pong понг понх coin монетка roll dice кости ver version версия хэлп halp kde кде lat
лат friday пятница proverb пословица fortune фортунка f ф anek анек анекдот buni cat кис drink праздник fox лис
frog лягушка horse лошадь лошадка monkeyuser owl сова сыч rabbit bunny кролик snail улитка tits boobs tities
boobies сиси сисечки butt booty ass попа попка xkcd);
boobies сиси сисечки butt booty ass попа попка xkcd dig копать fish fishing рыба рыбка рыбалка);
my $bingo = 0;
@@ -108,6 +106,17 @@ sub Command {
}
}
$#cmds = -1;
@cmds = qw (dig копать fish fishing рыба рыбка рыбалка);
while (my $check = pop @cmds) {
if ($cmd eq $check) {
$rmsg->{misc}->{msg_format} = 1;
$rmsg->{misc}->{username} = $highlight;
last;
}
}
{
do {
my $ready = eval { $main::RCONN->is_connected; };
@@ -120,18 +129,6 @@ sub Command {
$pubsub->json ($c->{'redis_router_channel'})->notify (
$c->{'redis_router_channel'} => $rmsg
);
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
$msg->typing ();
$reply = Dig $highlight;
sleep (irand (2) + 1);
$msg->replyMd ($reply);
return;
} elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fishing' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка' ) {
$msg->typing ();
$reply = Fish $highlight;
sleep (irand (2) + 1);
$msg->replyMd ($reply);
return;
} elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') {
$reply = << "MYHELP";
```

108
lib/BotLib/Archeologist.pm
View File

@@ -1,108 +0,0 @@
package BotLib::Archeologist;
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use DBI;
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Dig);
my $c = LoadConf ();
my $gamestatdir = $c->{gamestat}->{gamestatdir};
my $dbfile = sprintf '%s/gamestat.sqlite', $gamestatdir;
sub getRandomArtifact {
my $dbh;
$dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
$dbh->{sqlite_unicode} = 1;
my $rows_affected = $dbh->do ('PRAGMA foreign_keys=ON') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
$rows_affected = $dbh->do ('PRAGMA journal_mode=WAL') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
my $ary_ref = $dbh->selectall_arrayref ('SELECT name FROM artifacts WHERE id > 0 AND id < 10000') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
$dbh->disconnect or $log->warn (sprintf '[WARN] Unable to close gamestat db, sqlite error: %s', $dbh->errstr);
return $ary_ref->[irand ($#{ $ary_ref } + 1)]->[0];
}
sub Dig {
my $name = shift;
my @location = (
'в архивах',
'в гималаях',
'в интернете',
'в кармане',
'в клумбе',
'в лунном кратере',
'во льдах арктики',
'в морге',
'в окрестностях погоста',
'в песочнице',
'в пустыне Гоби',
'в пустыне Сахаре',
'в русле высохшей реки',
'в собственной памяти',
'в старом сортире',
'в углу',
'в цветочном горшке',
'на бабушкином огороде',
'на винчестере',
'на горе Арарат',
'на горном плато',
'на дне моря',
'на необитаемом острове',
'на первом слое сумрака',
'на просторах Украины',
);
my $find_probability = irand 100;
my $success_probability = irand 100;
my $artifact_age = irand 15000;
if ($find_probability <= 20) {
return sprintf 'По уши закопавшись %s, %s, нифига вы не выкопали! Может повезет в другом месте?', $location[irand ($#location + 1)], $name;
}
my $phrase = sprintf "Вы начали раскопки %s и усиленно роете лопатами, экскаватором...\n", $location[irand ($#location + 1)];
$phrase .= "Вам кажется, что ваш совочек ударился обо что-то твердое. Может, это клад?!\n\n";
my $artifact = getRandomArtifact();
if ($success_probability <= 25) {
$phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact, $artifact_age;
} else {
$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact, $artifact_age;
$phrase .= sprintf 'Извини, %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name;
}
return $phrase;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

122
lib/BotLib/Fisher.pm
View File

@@ -1,122 +0,0 @@
package BotLib::Fisher;
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use DBI;
use Log::Any qw ($log);
use Math::Random::Secure qw (irand);
use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Fish);
my $c = LoadConf ();
my $gamestatdir = $c->{gamestat}->{gamestatdir};
my $dbfile = sprintf '%s/gamestat.sqlite', $gamestatdir;
sub getRandomArtifact {
my $dbh;
$dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
$dbh->{sqlite_unicode} = 1;
my $rows_affected = $dbh->do ('PRAGMA foreign_keys=ON') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
$rows_affected = $dbh->do ('PRAGMA journal_mode=WAL') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
my $ary_ref = $dbh->selectall_arrayref ('SELECT name FROM artifacts WHERE id > 9999 AND id < 20000') or do {
$log->error (sprintf '[ERROR] Unable to get random artifact, sqlite error: %s', $dbh->errstr);
return undef;
};
$dbh->disconnect or $log->warn (sprintf '[WARN] Unable to close gamestat db, sqlite error: %s', $dbh->errstr);
return $ary_ref->[irand ($#{ $ary_ref } + 1)]->[0];
}
sub Fish {
my $name = shift;
my @location = (
'в поток',
'в озеро',
'в реку',
'в северный ледовитый океан',
'в индийский океан',
'в биде',
'в детский плавательный бассейн',
'в туалет',
'в кучу рвоты',
'в лужу мочи',
'в раковину',
'в слив ванной',
'в лужу грязи',
'в ведро воды',
'в бутылку с водкой',
'в ванную',
'в бочку с дождевой водой',
'в аквариум',
'в сугроб',
'в водопад',
'в чашку кофе',
'в стакан молока',
'в черную дыру',
'дно Удомельского реактора',
'на Марс',
'в соседнюю галактику',
'к соседу на балкон',
'далеко-далеко',
'далеко и надолго',
'на крышу дома',
);
my @material = (
'бамбуковую',
'фибергласовую',
'карбоновую',
'композитную',
);
my $find_probability = irand 100;
my $success_probability = irand 100;
my $weight = irand 7000;
my $phrase = sprintf "Вы забрасываете %s удочку %s.\nВы чувствуете поклёвку и начинаете быстро тащить что-то.\n", $material[irand ($#material + 1)], $location[irand ($#location + 1)];
if ($find_probability <= 20) {
$phrase .= sprintf 'Черт, твоя рыбка сорвалась, %s! Не беда, может потом повезет?', $name;
return $phrase;
}
my $artifact = getRandomArtifact ();
$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact, $weight;
if ($success_probability <= 25) {
$phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name;
} else {
$phrase .= sprintf 'Извини, %s, но это не новый рекорд! Однако, хорошая попытка!', $name;
}
return $phrase;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

115
lib/BotLib/Gamestat.pm
View File

@@ -1,115 +0,0 @@
package BotLib::Gamestat;
# Stores and calculates player stats for games
use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use DBI;
use English qw ( -no_match_vars );
use File::Path qw (make_path);
use String::Random qw (random_string);
use BotLib::Conf qw (LoadConf);
use BotLib::Util qw (trim utf2sha1);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (SeedArtifacts);
my $c = LoadConf ();
my $dir = $c->{gamestat}->{dir};
my $gamestatdir = $c->{gamestat}->{gamestatdir};
my $dbfile = sprintf '%s/gamestat.sqlite', $gamestatdir;
# assume that there is not too much artifacts.
sub SeedArtifacts {
open (my $AFH, '<', "$dir/archeologic_artifacts.txt") || die "No $dir/archeologic_artifacts.txt\n";
my @arch_artifacts;
while (my $artifact = <$AFH>) {
next if ($artifact =~ /^\s*$/);
$artifact = trim ($artifact);
push @arch_artifacts, $artifact;
}
close $AFH; ## no critic (InputOutput::RequireCheckedSyscalls)
open ($AFH, '<', "$dir/fisher_artifacts.txt") || die "No $dir/fisher_artifacts.txt\n";
my @fisher_artifacts;
while (my $artifact = <$AFH>) {
next if ($artifact =~ /^\s*$/);
$artifact = trim ($artifact);
push @fisher_artifacts, $artifact;
}
close $AFH; ## no critic (InputOutput::RequireCheckedSyscalls)
undef $AFH;
my $tablename = random_string ('..........');
$tablename = utf2sha1 ($tablename);
while ($tablename =~ /^\d/) {
$tablename = utf2sha1 ($tablename);
}
$tablename =~ s/[\/_\+]/a/g;
$tablename = lc ($tablename);
unless (-d $gamestatdir) {
make_path ($gamestatdir) || die "Unable to create $gamestatdir: $OS_ERROR\n";
}
my $dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '');
$dbh->{sqlite_unicode} = 1;
my $rows_affected = $dbh->do ('PRAGMA foreign_keys=ON') or die $dbh->errstr . "\n";
$rows_affected = $dbh->do ('PRAGMA journal_mode=WAL') or die $dbh->errstr . "\n";
# Open transaction
$dbh->begin_work or die $dbh->errstr . "\n";
my $query = <<"QUERY";
CREATE TABLE IF NOT EXISTS $tablename (
id INT UNIQUE NOT NULL, -- artifact id
name TEXT PRIMARY KEY -- artifact name
);
QUERY
$rows_affected = $dbh->do ($query) or die $dbh->errstr . "\n";
my $sth = $dbh->prepare ("REPLACE INTO $tablename(id,name) VALUES (?,?)") or die $dbh->errstr . "\n";
# Insert our archeological artifacts
my $counter = 0;
foreach my $artifact (@arch_artifacts) {
last if ($counter == 10000);
$sth->execute ($c, $artifact);
$counter++;
}
# Insert our fishing artifacts
$counter = 10000;
foreach my $artifact (@fisher_artifacts) {
last if ($counter == 20000);
$sth->execute ($c, $artifact);
$counter++;
}
# Add indexes
$rows_affected = $dbh->do ("CREATE INDEX IF NOT EXISTS myartifactid ON $tablename(id)") or die $dbh->errstr . "\n";
# Drop target table and replace it with our
$rows_affected = $dbh->do ('DROP TABLE IF EXISTS artifacts') or die $dbh->errstr . "\n";
$rows_affected = $dbh->do ("ALTER TABLE $tablename RENAME TO artifacts") or die $dbh->errstr . "\n";
# Close transaction
$dbh->commit or die $dbh->errstr . "\n";
$dbh->disconnect or warn (sprintf '[WARN] Unable to close gamestat db, sqlite error: %s', $dbh->errstr) . "\n";
return;
}
1;