84 lines
2.1 KiB
Perl
84 lines
2.1 KiB
Perl
package DoctorKarma::DB;
|
|
|
|
use v5.30.0;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use DBI;
|
|
use Const::Fast;
|
|
|
|
use DoctorKarma::Config;
|
|
|
|
const my $dbname => "@{[DoctorKarma::Config::CONFIG_DIR()]}/database.sqlite";
|
|
|
|
my @migrations = (
|
|
'CREATE TABLE options (
|
|
key TEXT PRIMARY KEY,
|
|
value TEXT
|
|
);',
|
|
'CREATE TABLE users (
|
|
id INTEGER PRIMARY KEY,
|
|
username TEXT,
|
|
karma INTEGER,
|
|
last_karma_given_date TEXT
|
|
)',
|
|
'ALTER TABLE users
|
|
ADD COLUMN first_name TEXT',
|
|
'CREATE TABLE items (
|
|
id INTEGER PRIMARY KEY AUTOINCREMENT,
|
|
word TEXT
|
|
)',
|
|
'CREATE TABLE inventory (
|
|
id_user INTEGER NOT NULL,
|
|
id_item INTEGER NOT NULL,
|
|
quantity INTEGER,
|
|
PRIMARY KEY (id_user, id_item),
|
|
FOREIGN KEY (id_user) REFERENCES users (id),
|
|
FOREIGN KEY (id_item) REFERENCES items (id)
|
|
)'
|
|
);
|
|
|
|
sub dbh {
|
|
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbname", '', '' , {
|
|
AutoCommit => 1,
|
|
RaiseError => 1,
|
|
sqlite_unicode => 1,
|
|
});
|
|
state $migrations_run = 0;
|
|
if (!$migrations_run) {
|
|
run_migrations($dbh);
|
|
$migrations_run = 1;
|
|
}
|
|
return $dbh;
|
|
}
|
|
|
|
sub run_migrations {
|
|
my $dbh = shift;
|
|
my $current_migration = _get_current_migration_number($dbh);
|
|
say $current_migration;
|
|
if ($current_migration < scalar @migrations) {
|
|
my @needed_migrations = @migrations[$current_migration .. $#migrations];
|
|
for my $migration (@needed_migrations) {
|
|
$dbh->do($migration);
|
|
if (!(0+$dbh->do('UPDATE options SET value = ? WHERE key = "migration"', undef, ++$current_migration))) {
|
|
$dbh->do('INSERT INTO options (key, value) VALUES ("migration", ?)', undef, $current_migration);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _get_current_migration_number {
|
|
my $dbh = shift;
|
|
local $dbh->{RaiseError} = 0;
|
|
my $migration = $dbh->selectrow_hashref(<<'EOF', {});
|
|
SELECT value FROM options WHERE key = 'migration'
|
|
EOF
|
|
my $value = 0;
|
|
if (defined $migration) {
|
|
$value = $migration->{value};
|
|
}
|
|
return $value;
|
|
}
|
|
1;
|