File Coverage

blib/lib/SHARYANTO/SQL/Schema.pm

Criterion	Covered	Total	%
statement	68	91	74.7
branch	28	58	48.2
condition	7	20	35.0
subroutine	6	6	100.0
pod	1	1	100.0
total	110	176	62.5

package SHARYANTO::SQL::Schema;

use 5.010001;
use strict;
use warnings;
use Log::Any '$log';

our $VERSION = '0.09'; # VERSION

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(create_or_update_db_schema);

our %SPEC;

$SPEC{create_or_update_db_schema} = {
    v => 1.1,
    summary => 'Routine and convention to create/update '.
        'your application\'s DB schema',
    description => <<'_',

With this routine (and some convention) you can easily create and update
database schema for your application in a simple way using pure SQL.

*Version*: version is an integer and starts from 1. Each software release with
schema change will bump the version number by 1. Version information is stored
in a special table called `meta` (SELECT value FROM meta WHERE
name='schema_version').

You supply the SQL statements in `spec`. `spec` is a hash which at least must
contain the key `latest_v` (an integer) and `install` (a series of SQL
statements to create the schema from nothing). It should be the SQL statements
to create the latest version of the schema.

There should also be zero or more `upgrade_to_v$VERSION` keys, the value of each
is a series of SQL statements to upgrade from ($VERSION-1) to $VERSION. So there
could be `upgrade_to_v2`, `upgrade_to_v3`, and so on up the latest version.

This routine will check the existence of the `meta` table and the current schema
version. If `meta` table does not exist yet, the SQL statements in `install`
will be executed. The `meta` table will also be created and a row
('schema_version', 1) is added.

If `meta` table already exists, schema version will be read from it and one or
more series of SQL statements from `upgrade_to_v$VERSION` will be executed to
bring the schema to the latest version.

Currently only tested on MySQL, Postgres, and SQLite. Postgres is recommended
because it can do transactional DDL (a failed upgrade in the middle will not
cause the database schema state to be inconsistent, e.g. in-between two
versions).

_
    args => {
        spec => {
            schema => ['hash*'], # XXX require 'install' & 'latest_v' keys
            summary => 'SQL statements to create and update schema',
            req => 1,
            description => <<'_',

Example:

    {
        latest_v => 3,

        install => [
            'CREATE TABLE IF NOT EXISTS t1 (...)',
            'CREATE TABLE IF NOT EXISTS t2 (...)',
        ],

        upgrade_to_v2 => [
            'ALTER TABLE t1 ADD COLUMN c5 INT NOT NULL',
            'CREATE UNIQUE INDEX i1 ON t2(c1)',
        ],

        upgrade_to_v3 => [
            'ALTER TABLE t2 DROP COLUMN c2',
        ],
    }

_
        },
        dbh => {
            schema => ['obj*'],
            summary => 'DBI database handle',
            req => 1,
        },
    },
    "_perinci.sub.wrapper.validate_args" => 0,
};
sub create_or_update_db_schema {
    my %args = @_; if (!exists($args{'spec'})) { return [400, "Missing argument: spec"] } my $_sahv_dpath = []; my $arg_err; ((defined($args{'spec'})) ? 1 : (($arg_err //= (@$_sahv_dpath ? '@'.join("/",@$_sahv_dpath).": " : "") . "Required input not specified"),0)) && ((ref($args{'spec'}) eq 'HASH') ? 1 : (($arg_err //= (@$_sahv_dpath ? '@'.join("/",@$_sahv_dpath).": " : "") . "Input is not of type hash"),0)); if ($arg_err) { return [400, "Invalid argument value for spec: $arg_err"] } if (!exists($args{'dbh'})) { return [400, "Missing argument: dbh"] } require Scalar::Util; ((defined($args{'dbh'})) ? 1 : (($arg_err //= (@$_sahv_dpath ? '@'.join("/",@$_sahv_dpath).": " : "") . "Required input not specified"),0)) && ((Scalar::Util::blessed($args{'dbh'})) ? 1 : (($arg_err //= (@$_sahv_dpath ? '@'.join("/",@$_sahv_dpath).": " : "") . "Input is not of type object"),0)); if ($arg_err) { return [400, "Invalid argument value for dbh: $arg_err"] } # VALIDATE_ARGS

    my $spec = $args{spec};
    my $dbh  = $args{dbh};

    local $dbh->{RaiseError};

    # first, check current schema version

    # XXX check spec: latest_v and upgrade_to_v$V must synchronize

    my $v;
    my @t = $dbh->tables("", undef, "meta");
    if (@t) {
        ($v) = $dbh->selectrow_array(
            "SELECT value FROM meta WHERE name='schema_version'");
    }
    $v //= 0;

    my $orig_v = $v;

    # perform schema upgrade atomically per version (at least for db that
    # supports it like postgres)
    my $err;

    my $latest_v = $spec->{latest_v};
    if (!defined($latest_v)) {
        $latest_v = 1;
        for (keys %$spec) {
            next unless /^upgrade_to_v(\d+)$/;
            $latest_v = $1 if $1 > $latest_v;
        }
    }

  STEP:
    for my $i (($v+1) .. $latest_v) {
        undef $err;
        my $last;

        $dbh->begin_work;

        if ($v == 0 && !@t) {
            $dbh->do("CREATE TABLE meta (name VARCHAR(64) NOT NULL PRIMARY KEY, value VARCHAR(255))")
                or do { $err = $dbh->errstr; last STEP };
            $dbh->do("INSERT INTO meta (name,value) VALUES ('schema_version',0)")
                or do { $err = $dbh->errstr; last STEP };
        }

        if ($v == 0 && $spec->{install}) {
            $log->debug("Updating database schema from version $v to $i ...");
            my $j = 0;
            for my $sql (@{ $spec->{install} }) {
                $dbh->do($sql) or do { $err = $dbh->errstr; last STEP };
                $i++;
            }
            $dbh->do("UPDATE meta SET value=$latest_v WHERE name='schema_version'")
                or do { $err = $dbh->errstr; last STEP };
            $last++;
        } else {
            $log->debug("Updating database schema from version $v to $i ...");
            $spec->{"upgrade_to_v$i"}
                or do { $err = "Error in spec: upgrade_to_v$i not specified"; last STEP };
            for my $sql (@{ $spec->{"upgrade_to_v$i"} }) {
                $dbh->do($sql) or do { $err = $dbh->errstr; last STEP };
            }
            $dbh->do("UPDATE meta SET value=$i WHERE name='schema_version'")
                or do { $err = $dbh->errstr; last STEP };
        }

        $dbh->commit or do { $err = $dbh->errstr; last STEP };

        $v = $i;
    }
    if ($err) {
        $log->error("Can't upgrade schema (from version $v): $err");
        $dbh->rollback;
        return [500, "Can't upgrade schema (from version $v): $err"];
    } else {
        return [200, "OK (upgraded from v=$orig_v)", {version=>$v}];
    }

    [200];
}

1;
# ABSTRACT: Routine and convention to create/update your application's DB schema

__END__