complete documentation for --upgrade

[debbugs.git] / lib / Debbugs / DB / Util.pm

diff --git a/lib/Debbugs/DB/Util.pm b/lib/Debbugs/DB/Util.pm
index d241f3343ee39b7f27f2e74f59943d65a84addb3..e2b8b638f8c8b4f94b8514a771984f2d7d4714d1 100644 (file)
--- a/lib/Debbugs/DB/Util.pm
+++ b/lib/Debbugs/DB/Util.pm
@@ -23,21 +23,11 @@ None known.
 
 use warnings;
 use strict;
-use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
 
-BEGIN{
-     ($VERSION) = q$Revision$ =~ /^Revision:\s+([^\s+])/;
-     $DEBUG = 0 unless defined $DEBUG;
+use base qw(DBIx::Class);
 
-     @EXPORT = ();
-     %EXPORT_TAGS = (select => [qw(select_one)],
-                    execute => [qw(prepare_execute)]
-                   );
-     @EXPORT_OK = ();
-     Exporter::export_ok_tags(keys %EXPORT_TAGS);
-     $EXPORT_TAGS{all} = [@EXPORT_OK];
-}
+use Debbugs::Common qw(open_compressed_file);
+use File::Find qw();
 
 =head2 select
 
@@ -47,44 +37,114 @@ Routines for select requests
 
 =item select_one
 
-       select_one($dbh,$sql,@bind_vals)
+       $schema->select_one($sql,@bind_vals)
 
 Returns the first column from the first row returned from a select statement
 
 =cut
 
 sub select_one {
-    my ($dbh,$sql,@bind_vals) = @_;
-    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 ($self,$sql,@bind_vals) = @_;
+    my $sth = $self->prepare_execute($sql,@bind_vals);
     my $results = $sth->fetchall_arrayref([0]);
-    $sth->finish();
     return (ref($results) and ref($results->[0]))?$results->[0][0]:undef;
 }
 
 =item prepare_execute
 
-       prepare_execute($dbh,$sql,@bind_vals)
+       $schema->prepare_execute($sql,@bind_vals)
 
 Prepares and executes a statement
 
 =cut
 
 sub prepare_execute {
-    my ($dbh,$sql,@bind_vals) = @_;
-    my $sth = $dbh->
-        prepare_cached($sql,
+    my ($self,$sql,@bind_vals) = @_;
+    $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 execute statement: ".$dbh->errstr();
-    $sth->finish();
+                      or die "Unable to prepare statement: $sql";
+                  $sth->execute(@bind_vals) or
+                      die "Unable to execute statement: ".$dbh->errstr();
+                  return $sth;
+              });
+}
+
+=item sql_file_in_txn
+
+C<sql_file_in_txn();>
+
+
+
+=cut
+sub sql_file_in_txn {
+    my ($self,$fn) = @_;
+    my $fh = open_compressed_file($fn) or
+       die "Unable to open $fn for reading: $!";
+    local $/;
+    my $sql = <$fh>;
+    defined($sql) or die "Unable to read from file: $!";
+    $self->prepare_execute($sql);
+}
+
+
+
+=back
+
+=head2 Database Upgrade and Version
+
+=over
+
+=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
+    @files = sort {$a->{from} <=> $b->{from}}
+       # strip out upgrades which don't need to be run
+       grep {$_->{from} >= $current_version } @files;
+
+    return @files;
+}
+
+
+
 
 =back