#!/usr/bin/perl

use strict;

use Getopt::Long;

my ($dbh_module, $schema_file, $install);

$install = 0; # install new database, ignore existence of variables

GetOptions(
	'h|help'     => sub { &help },
	'm|module=s' => \$dbh_module,
	's|schema=s' => \$schema_file,
	'install'    => \$install,
);

$dbh_module ||= 'My::UpdateDB';

eval "use $dbh_module";
die $@ if $@;

my $dbh     = $dbh_module->new;
my $db_name = $dbh_module->db_dsn;
my $sql     = $dbh_module->sql;

my $ver_get = $sql->{'ver_get'};
my $ver_upd = $sql->{'ver_upd'};

print "updating db schema using db dsn '$db_name'\n";

my $schema_version;

eval {
	($schema_version) = $dbh->selectrow_array ($ver_get);
};

unless ($schema_version) {
	die "can't fetch db_schema version, statement: [$ver_get]"
		unless $install;
}

$schema_version = 'NEW'
	if $install;

$schema_file ||= $dbh_module->schema_file;

die "can't open schema file '$schema_file'"
	unless open SCHEMA, $schema_file;

my $found   = 0;
my $harvest = 0;

if ($install) {
	$found   = 1;
	$harvest = 1;
}

my $new_items = '';
my $latest_version = '';

while (<SCHEMA>) {
	if ($_ =~ /-{2,}\s*(\d\d\d\d-\d\d-\d\d(?:\.\d+)?)/) {
		if ($schema_version eq $1) {
			# warn "we found latest declaration, start to find next declaration\n";
			$found = 1;
			next;
		}
		next unless $found;
		
		$latest_version = $1;
		$harvest = 1;
	} elsif ($harvest) {
		$new_items .= $_;
	}
}

close SCHEMA;

print ("no updates, db schema version: $schema_version\n"), exit
	if $latest_version eq '' or $schema_version eq $latest_version;

print "current version: $schema_version\n    new version: $latest_version\nupdating... ";

eval {
	$dbh->begin_work;
	$dbh->do ($new_items);
	my $sth = $dbh->prepare ('update var set var_value = ? where var_name = ?');
	$sth->execute ($latest_version, 'db_schema_version');
};

if ($@){
	print "database error: $@\n";
	eval {$dbh->rollback};
	die "can't apply new db schema, rollback";
}

$dbh->commit;

print "done\n";

package My::UpdateDB;

use strict;

sub dbh_class {
	return 'DBI';
}

sub db_dsn {
	return '';
}

sub db_user {
	return undef;
}

sub db_pass {
	return undef;
}

sub db_args {
	# beware: if you modify these options, script may not work
	return {
		RaiseError => 1,
		AutoCommit => 1,
	};
}

sub sql {
	return {
		ver_get => "select var_value from var where var_name = 'db_schema_version';",
		ver_upd => "update var set var_value = ? where var_name = ?;",
	};
}

sub schema_file {
	return '';
}

sub new {
	my $cn = shift; # class name
	
	my $dbh_class = $cn->dbh_class;
	
	eval "use $dbh_class";
	die $@ if $@;
	
	my $dsn  = $cn->db_dsn;
	my $user = $cn->db_user;
	my $pass = $cn->db_pass;
	my $args = $cn->db_args;
	
	my $dbh = $dbh_class->connect ($dsn, $user, $pass, $args);
	
	return $dbh;
}

"true";