package 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;