eddbcc6277
* Move artifacts to separate files + Implement db seed with artifacts + Add gamedata_seed.pl script to seed artifacts to db
109 lines
3.6 KiB
Perl
109 lines
3.6 KiB
Perl
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:
|