Prep for gamestat implementation
* Move artifacts to separate files + Implement db seed with artifacts + Add gamedata_seed.pl script to seed artifacts to db
This commit is contained in:
eleksir
@@ -6,72 +6,53 @@ 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 @artifact = (
|
||||
'амулет Мерлина',
|
||||
'библиотеку Ивана Грозного',
|
||||
'деревянную плошку',
|
||||
'диплока',
|
||||
'доски Ноева Ковчега',
|
||||
'древний презерватив из бараньей кишки',
|
||||
'икону',
|
||||
'инсталятор Windows 3.11',
|
||||
'истлевший гроб',
|
||||
'каменный топор',
|
||||
'клад со златом-серебром',
|
||||
'кривой нож',
|
||||
'ледяную глыбу',
|
||||
'лунный грунт',
|
||||
'мамонта',
|
||||
'мамонтёнка',
|
||||
'метеорит',
|
||||
'мумию фараона Тутанхамона',
|
||||
'носки прапорщика (поставит в угол)',
|
||||
'обломки грузинской керамики',
|
||||
'птеродактиля',
|
||||
'рубль с Лениным',
|
||||
'рыцарские доспехи',
|
||||
'синий мох',
|
||||
'скелет',
|
||||
'скелет собаки по кличке Беня',
|
||||
'тиранозавтра',
|
||||
'тотем индейцев',
|
||||
'трубу с туркменским газом',
|
||||
'скорбь еврейского народа',
|
||||
'залежи активированного угля',
|
||||
'не очень новый завет',
|
||||
'мать леннарта поттеринга',
|
||||
'руководство "начинающему археологу"',
|
||||
'слово о полку игореве и дело о полку игореве, вместе с игорем',
|
||||
'телепрограмму канала A-one',
|
||||
'могилу искателя могил',
|
||||
'заплесневевший кусок хлеба',
|
||||
'преемник радиоприемника',
|
||||
'глушитель от ВАЗ-2106',
|
||||
'чувство удовлетворения',
|
||||
'крота',
|
||||
'воспоминания о былой любви',
|
||||
'грязистор',
|
||||
'египетское мумиё',
|
||||
'окаменелый камень',
|
||||
'кладку яиц рептилоида',
|
||||
'яму',
|
||||
'чеснок и стрелы',
|
||||
'доллар по 30',
|
||||
'несмазанные скрижали',
|
||||
'четырелобита',
|
||||
'чучело тролля',
|
||||
'целое ничего',
|
||||
);
|
||||
|
||||
my @location = (
|
||||
'в архивах',
|
||||
'в гималаях',
|
||||
@@ -110,11 +91,12 @@ sub Dig {
|
||||
|
||||
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[irand ($#artifact + 1)], $artifact_age;
|
||||
$phrase .= sprintf '%s стал лучшим археологом, выкопав %s! возраст артефакта - %s лет!', $name, $artifact, $artifact_age;
|
||||
} else {
|
||||
$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact[irand ($#artifact + 1)], $artifact_age;
|
||||
$phrase .= sprintf "Поздравляю, %s! Вы только что выкопали %s, возраст - %s лет!\n", $name, $artifact, $artifact_age;
|
||||
$phrase .= sprintf 'Извини, %s, но на артефакт это не тянет! Однако, попытка хорошая!', $name;
|
||||
}
|
||||
|
||||
|
||||
@@ -6,66 +6,54 @@ 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 @artifact = (
|
||||
'семикрылого чешуйчатого пятихуя',
|
||||
'разумного конденсатора',
|
||||
'сальмонеллу',
|
||||
'селёдку',
|
||||
'желтоперого тунца',
|
||||
'розовую сальмонеллу',
|
||||
'голавля',
|
||||
'барбуса',
|
||||
'окуня',
|
||||
'верхоплавку',
|
||||
'коричневую форель',
|
||||
'полярника',
|
||||
'плотву',
|
||||
'зубатку',
|
||||
'солнечную рыбу',
|
||||
'старую шину',
|
||||
'скользкую корягу',
|
||||
'лампу джина',
|
||||
'любовное послание в бутылке',
|
||||
'старое бревно',
|
||||
'резиновый сапог',
|
||||
'труп',
|
||||
'Лох-Несское чудовище',
|
||||
'старую рыбацкую приманку',
|
||||
'кусок Титаника',
|
||||
'обломок Атлантиды',
|
||||
'кита',
|
||||
'кальмара',
|
||||
'дельфина',
|
||||
'ската',
|
||||
'подводную лодку',
|
||||
'медузу',
|
||||
'морскую звезду',
|
||||
'электрического угря',
|
||||
'большую белую акулу',
|
||||
'аквалангиста',
|
||||
'монстра',
|
||||
'вируса',
|
||||
'сырую пачку сигарет',
|
||||
'водоросли',
|
||||
'якорь от лодки',
|
||||
'водяного',
|
||||
'русалку',
|
||||
'палтуса',
|
||||
'труп собаки по кличке Беня',
|
||||
'олигофрена Проню',
|
||||
'огеймера Фишкина',
|
||||
);
|
||||
|
||||
my @location = (
|
||||
'в поток',
|
||||
'в озеро',
|
||||
@@ -117,7 +105,8 @@ sub Fish {
|
||||
return $phrase;
|
||||
}
|
||||
|
||||
$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact[irand ($#artifact + 1)], $weight;
|
||||
my $artifact = getRandomArtifact ();
|
||||
$phrase .= sprintf "Поздравляю, %s! Вы только что поймали %s! аж на %d кило!\n\n", $name, $artifact, $weight;
|
||||
|
||||
if ($success_probability <= 25) {
|
||||
$phrase .= sprintf 'Ё-мое!!! А это ведь новый рекорд! Продолжай в том же духе, %s!', $name;
|
||||
|
||||
116
lib/BotLib/Gamestat.pm
Normal file
116
lib/BotLib/Gamestat.pm
Normal file
@@ -0,0 +1,116 @@
|
||||
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";
|
||||
my @arch_artifacts;
|
||||
|
||||
while (my $artifact = <$AFH>) {
|
||||
next if ($artifact =~ /^\s*$/);
|
||||
$artifact = trim ($artifact);
|
||||
push @arch_artifacts, $artifact;
|
||||
}
|
||||
|
||||
close $AFH;
|
||||
|
||||
open ($AFH, '<', "$dir/fisher_artifacts.txt") || die "No $dir/fisher_artifacts.txt";
|
||||
my @fisher_artifacts;
|
||||
|
||||
while (my $artifact = <$AFH>) {
|
||||
next if ($artifact =~ /^\s*$/);
|
||||
$artifact = trim ($artifact);
|
||||
push @fisher_artifacts, $artifact;
|
||||
}
|
||||
|
||||
close $AFH;
|
||||
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 $dir: $OS_ERROR";
|
||||
}
|
||||
|
||||
my $dbh = DBI->connect ("dbi:SQLite:$dbfile", '', '');
|
||||
$dbh->{sqlite_unicode} = 1;
|
||||
my $rows_affected = $dbh->do ('PRAGMA foreign_keys=ON') or die $dbh->errstr;
|
||||
$rows_affected = $dbh->do ('PRAGMA journal_mode=WAL') or die $dbh->errstr;
|
||||
|
||||
# Open transaction
|
||||
$dbh->begin_work or die $dbh->errstr;
|
||||
|
||||
$rows_affected = $dbh->do (
|
||||
qq {
|
||||
CREATE TABLE IF NOT EXISTS $tablename (
|
||||
id INT UNIQUE NOT NULL, -- artifact id
|
||||
name TEXT PRIMARY KEY -- artifact name
|
||||
);
|
||||
}
|
||||
) or die $dbh->errstr;
|
||||
|
||||
my $sth = $dbh->prepare ("REPLACE INTO $tablename(id,name) VALUES (?,?)") or die $dbh->errstr;
|
||||
|
||||
# Insert our archeological artifacts
|
||||
my $c = 0;
|
||||
|
||||
foreach my $artifact (@arch_artifacts) {
|
||||
last if ($c == 10000);
|
||||
$sth->execute ($c, $artifact);
|
||||
$c++;
|
||||
}
|
||||
|
||||
# Insert our fishing artifacts
|
||||
$c = 10000;
|
||||
|
||||
foreach my $artifact (@fisher_artifacts) {
|
||||
last if ($c == 20000);
|
||||
$sth->execute ($c, $artifact);
|
||||
$c++;
|
||||
}
|
||||
|
||||
# Add indexes
|
||||
$rows_affected = $dbh->do ("CREATE INDEX IF NOT EXISTS myartifactid ON $tablename(id)") or die $dbh->errstr;
|
||||
|
||||
# Drop target table and replace it with our
|
||||
$rows_affected = $dbh->do ("DROP TABLE IF EXISTS artifacts") or die $dbh->errstr;
|
||||
$rows_affected = $dbh->do ("ALTER TABLE $tablename RENAME TO artifacts") or die $dbh->errstr;
|
||||
|
||||
# Close transaction
|
||||
$dbh->commit or die $dbh->errstr;
|
||||
$dbh->disconnect or warn (sprintf '[WARN] Unable to close gamestat db, sqlite error: %s', $dbh->errstr);
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user