From: Don Armstrong <don@donarmstrong.com>
Date: Sun, 2 Aug 2020 00:52:04 +0000 (-0700)
Subject: Add simplistic database upgrade mechanism
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=084a31cbcee60e2f6de32d824aaec408018cd1d5;p=debbugs.git

Add simplistic database upgrade mechanism

 - Integer versions, increasing
---

diff --git a/bin/debbugs-installsql b/bin/debbugs-installsql
index 1156f178..ed407eba 100755
--- a/bin/debbugs-installsql
+++ b/bin/debbugs-installsql
@@ -76,6 +76,7 @@ use if (-d $FindBin::Bin.'/../.git/' && $INC[0] =~ m#^/#),
     lib => $FindBin::Bin.'/../lib/';
 
 use Debbugs::DB;
+use JSON;
 
 my %options = (debug           => 0,
 	       help            => 0,
@@ -136,18 +137,28 @@ my $s = Debbugs::DB->connect($options{dsn}) or
 
 
 if ($options{current_version}) {
-    print "The current database version is: ".$s->database_version."\n";
+    print "The current database version is: ".$s->db_version."\n";
     exit 0;
 } elsif ($options{install}) {
     $s->sql_file_in_txn($options{deployment_dir}.'/debbugs_schema.sql');
 } elsif ($options{upgrade}) {
-    my @upgrades = $s->upgrades_to_run($options{deployment_dir});
+    my @upgrades = $s->upgrades_to_run($options{deployment_dir}.'/upgrade');
     for my $u_f (@upgrades) {
 	eval {
-	    $s->sql_file_in_txn($u_f->file);
+	    package fake;
+	    require $u_f->{file};
+	    $s->txn_do(sub {fake::upgrade($s);
+			    $s->resultset('DbVersion')->
+				create({version => $u_f->{to},
+					metadata => JSON::encode_json({from => $u_f->{from}+0,
+								       to => $u_f->{to}+0,
+								       file => $u_f->{file},
+								      }),
+				       });
+			});
 	};
 	if ($@) {
-	    print STDERR "Upgrade from $s->database_version to $u_f->version failed: $@";
+	    print STDERR "Upgrade from $s->database_version to $u_f->{to} failed: $@";
 	    exit 1;
 	}
     }
diff --git a/lib/Debbugs/DB/Result/DbVersion.pm b/lib/Debbugs/DB/Result/DbVersion.pm
new file mode 100644
index 00000000..d5a4453b
--- /dev/null
+++ b/lib/Debbugs/DB/Result/DbVersion.pm
@@ -0,0 +1,105 @@
+use utf8;
+package Debbugs::DB::Result::DbVersion;
+
+# Created by DBIx::Class::Schema::Loader
+# DO NOT MODIFY THE FIRST PART OF THIS FILE
+
+=head1 NAME
+
+Debbugs::DB::Result::DbVersion - Version of the Database Schema
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Core';
+
+=head1 COMPONENTS LOADED
+
+=over 4
+
+=item * L<DBIx::Class::InflateColumn::DateTime>
+
+=item * L<DBIx::Class::TimeStamp>
+
+=back
+
+=cut
+
+__PACKAGE__->load_components("InflateColumn::DateTime", "TimeStamp");
+
+=head1 TABLE: C<db_version>
+
+=cut
+
+__PACKAGE__->table("db_version");
+
+=head1 ACCESSORS
+
+=head2 version
+
+  data_type: 'integer'
+  default_value: 0
+  is_nullable: 0
+
+Version number of the database
+
+=head2 date
+
+  data_type: 'timestamp with time zone'
+  default_value: current_timestamp
+  is_nullable: 1
+  original: {default_value => \"now()"}
+
+Date the database was upgraded to this version
+
+=head2 metadata
+
+  data_type: 'jsonb'
+  default_value: jsonb_object('{}'::text[])
+  is_nullable: 0
+
+Details about how the database was upgraded to this version
+
+=cut
+
+__PACKAGE__->add_columns(
+  "version",
+  { data_type => "integer", default_value => 0, is_nullable => 0 },
+  "date",
+  {
+    data_type     => "timestamp with time zone",
+    default_value => \"current_timestamp",
+    is_nullable   => 1,
+    original      => { default_value => \"now()" },
+  },
+  "metadata",
+  {
+    data_type     => "jsonb",
+    default_value => \"jsonb_object('{}'::text[])",
+    is_nullable   => 0,
+  },
+);
+
+=head1 UNIQUE CONSTRAINTS
+
+=head2 C<db_version_version_key>
+
+=over 4
+
+=item * L</version>
+
+=back
+
+=cut
+
+__PACKAGE__->add_unique_constraint("db_version_version_key", ["version"]);
+
+
+# Created by DBIx::Class::Schema::Loader v0.07049 @ 2020-08-01 13:43:06
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:xf/jizKdQyo+8jAbc0i3cg
+
+
+# You can replace this text with custom code or comments, and it will be preserved on regeneration
+1;
diff --git a/lib/Debbugs/DB/Util.pm b/lib/Debbugs/DB/Util.pm
index 7c52a044..f7dc38f7 100644
--- a/lib/Debbugs/DB/Util.pm
+++ b/lib/Debbugs/DB/Util.pm
@@ -27,6 +27,7 @@ use strict;
 use base qw(DBIx::Class);
 
 use Debbugs::Common qw(open_compressed_file);
+use File::Find qw();
 
 =head2 select
 
@@ -44,20 +45,8 @@ Returns the first column from the first row returned from a select statement
 
 sub select_one {
     my ($self,$sql,@bind_vals) = @_;
-    my $results =
-	$self->storage->
-	dbh_do(sub {
-		   my ($s,$dbh) = @_;
-		   my $sth = $dbh->
-        prepare_cached($sql,
-                      {dbi_dummy => __FILE__.__LINE__ })
-        or die "Unable to prepare statement: $sql";
-		   $sth->execute(@bind_vals) or
-		       die "Unable to select one: ".$dbh->errstr();
-		   my $results = $sth->fetchall_arrayref([0]);
-		   $sth->finish();
-		   return $results;
-	       });
+    my $sth = $self->prepare_execute($sql,@bind_vals);
+    my $results = $sth->fetchall_arrayref([0]);
     return (ref($results) and ref($results->[0]))?$results->[0][0]:undef;
 }
 
@@ -80,7 +69,7 @@ sub prepare_execute {
 		       or die "Unable to prepare statement: $sql";
 		   $sth->execute(@bind_vals) or
 		       die "Unable to execute statement: ".$dbh->errstr();
-		   $sth->finish();
+		   return $sth;
 	       });
 }
 
@@ -102,6 +91,62 @@ sub sql_file_in_txn {
 }
 
 
+
+=back
+
+=head2 Database Upgrade and Version
+
+=item db_version
+
+C<db_version();>
+
+Returns the current database version (integer)
+
+=cut
+sub db_version {
+    my ($self) = @_;
+    return $self->select_one('SELECT db_version()');
+}
+
+=item upgrades_to_run
+
+C<upgrades_to_run();>
+
+Returns the set of upgrades which will have to be run (in order) to upgrade the
+database to the current version
+
+=cut
+
+sub upgrades_to_run {
+    my ($self,$deployment_dir) = @_;
+
+    my $current_version = $self->db_version();
+
+    my @files;
+    File::Find::find(sub {
+			 if (-f $_ and /^schema_(\d+)_to_(\d+)\.pl$/) {
+			     push @files, {file => $File::Find::name,
+					   from => $1,
+					   to => $2,
+					  };
+			 }
+		     },
+		     $deployment_dir
+		    );
+    # sort the upgrades
+    use Data::Dumper;
+    print STDERR Dumper(@files);
+    @files = sort {$a->{from} <=> $b->{from}}
+	# strip out upgrades which don't need to be run
+	grep {$_->{from} >= $current_version } @files;
+
+    print STDERR Dumper(@files);
+    return @files;
+}
+
+
+
+
 =back
 
 =cut
diff --git a/sql/upgrade/template_schema_XX_to_YY.pl b/sql/upgrade/template_schema_XX_to_YY.pl
new file mode 100644
index 00000000..470f6262
--- /dev/null
+++ b/sql/upgrade/template_schema_XX_to_YY.pl
@@ -0,0 +1,9 @@
+sub upgrade {
+    my $s = shift;
+print STDERR "Foo";
+    $s->prepare_execute(<<'SQL');
+SELECT * FROM db_version;
+SQL
+}
+
+1;