Something went wrong. Try again.
Perl game server for TLE Community
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152package Lacuna::DB::Migrate;
# Thin wrapper around DBIx::Class::DeploymentHandler for Lacuna::DB. Deploy# and upgrade SQL lives under var/ddl/ (one subdirectory per version, laid# out the way DeploymentHandler expects -- see its docs for the exact# directory shapes it reads from and writes to).## Used by:# bin/migrate_db.pl -- prod boot: install/upgrade, safe every time# bin/check_db_migration.pl -- dev boot: refuse to start if out of date# bin/setup/init_lacuna.pl -- dev bootstrap: wipe and redeploy from scratch
use strict;use warnings;use 5.010;use DBIx::Class::DeploymentHandler;use Lacuna;
use constant SCRIPT_DIRECTORY => '/home/lacuna/server/var/ddl';use constant VERSION_TABLE => 'dbix_class_deploymenthandler_versions';
# Serializes upgrade() across processes/containers, so two `server` boots# racing each other (e.g. a restart) can't run DDL concurrently.use constant LOCK_NAME => 'lacuna_schema_migration';
sub _dh { my (%args) = @_; return DBIx::Class::DeploymentHandler->new({ schema => Lacuna->db, script_directory => SCRIPT_DIRECTORY, databases => 'MySQL', force_overwrite => 0, %args, });}
# The version the currently-running code expects (Lacuna::DB's $VERSION).sub schema_version { return _dh()->schema_version;}
# The version recorded in the database, or undef if the database has never# been deployed through DeploymentHandler at all.sub database_version { my $dh = _dh(); return $dh->version_storage_is_installed ? $dh->database_version : undef;}
# True if the database isn't at the version the code expects.sub pending { my $db_version = database_version(); return 1 if !defined $db_version; return $db_version ne schema_version();}
# True if the connected database has any tables at all. Used to tell a# genuinely brand new database apart from one that simply predates# DeploymentHandler tracking -- "no version table" alone conflates the two,# and treating the latter as the former means running install()'s# DROP-TABLE-then-CREATE-TABLE deploy DDL over real data. See upgrade().sub _database_has_tables { my $dbh = Lacuna->db->storage->dbh; my ($count) = $dbh->selectrow_array( 'SELECT COUNT(*) FROM information_schema.tables WHERE table_schema = DATABASE()' ); return $count > 0;}
# Safe to call on every boot: installs from scratch on a brand new (empty)# database, applies whatever upgrade steps are outstanding on a tracked one,# and does nothing if the database is already current. Returns the resulting# version.## Refuses to run at all -- rather than guessing -- if the database has# tables but no version-tracking table: that's not a fresh database, it's an# untracked one (e.g. one that predates this tooling, or was just restored# from a backup), and installing over it would drop and recreate every# table. Use stamp() once, deliberately, to bring it under tracking first.sub upgrade { my $dbh = Lacuna->db->storage->dbh;
my ($got_lock) = $dbh->selectrow_array('SELECT GET_LOCK(?, 60)', undef, LOCK_NAME); die "Lacuna::DB::Migrate: could not acquire the schema migration lock within 60s\n" unless $got_lock;
my $result = eval { my $dh = _dh(); if ($dh->version_storage_is_installed) { $dh->upgrade; } elsif (_database_has_tables()) { die "Lacuna::DB::Migrate: this database has existing tables but no " . VERSION_TABLE . " -- refusing to install, which would drop and " . "recreate every table and destroy the data in them.\n" . "This looks like a database that predates DeploymentHandler " . "tracking (or was restored from a backup taken before it). " . "Stamp it at the version its current schema actually matches, " . "then re-run this:\n" . " perl bin/stamp_db_version.pl <version>\n"; } else { $dh->install; } $dh->database_version; }; my $error = $@;
$dbh->do('SELECT RELEASE_LOCK(?)', undef, LOCK_NAME);
die $error if $error; return $result;}
# One-time recovery/bootstrap primitive for a database that already has# tables but was never deployed through DeploymentHandler. Creates *only*# the version-tracking table and records the given version -- unlike# install(), it never touches any other table. upgrade() refuses to run# until this (or a real install against a genuinely empty database) has# happened, so this has to be a deliberate, human-run step: see# bin/stamp_db_version.pl.sub stamp { my ($version) = @_; die "Lacuna::DB::Migrate::stamp: version is required\n" unless defined $version;
my $dh = _dh(); die 'Lacuna::DB::Migrate: version storage is already installed (at version ' . $dh->database_version . ") -- refusing to overwrite it.\n" if $dh->version_storage_is_installed;
$dh->install_version_storage; $dh->add_database_version({ version => $version }); return $dh->database_version;}
# Dev-only, destructive: drops the version-tracking table (if present) and# redeploys the whole schema from scratch, dropping/recreating every table.# Used by bin/setup/init_lacuna.pl, which already wipes the star map on every# run -- this just keeps the version table in step with that reset. Relies on# the deploy DDL itself dropping each table first (see# bin/prepare_db_migration.pl), since install() runs the already-generated,# committed SQL as-is rather than regenerating it with different options.sub reinstall { my $dbh = Lacuna->db->storage->dbh; $dbh->do('DROP TABLE IF EXISTS ' . VERSION_TABLE);
my $dh = _dh(); $dh->install; return $dh->database_version;}
1;