lib/Debbugs/DB/Util.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later version. See the
   3 # file README and COPYING for more information.
   4 # Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
   5
   6 package Debbugs::DB::Util;
   7
   8 =head1 NAME
   9
  10 Debbugs::DB::Util -- Utility routines for the database
  11
  12 =head1 SYNOPSIS
  13
  14
  15 =head1 DESCRIPTION
  16
  17
  18 =head1 BUGS
  19
  20 None known.
  21
  22 =cut
  23
  24 use warnings;
  25 use strict;
  26
  27 use base qw(DBIx::Class);
  28
  29 use Debbugs::Common qw(open_compressed_file);
  30 use File::Find qw();
  31
  32 =head2 select
  33
  34 Routines for select requests
  35
  36 =over
  37
  38 =item select_one
  39
  40         $schema->select_one($sql,@bind_vals)
  41
  42 Returns the first column from the first row returned from a select statement
  43
  44 =cut
  45
  46 sub select_one {
  47     my ($self,$sql,@bind_vals) = @_;
  48     my $sth = $self->prepare_execute($sql,@bind_vals);
  49     my $results = $sth->fetchall_arrayref([0]);
  50     return (ref($results) and ref($results->[0]))?$results->[0][0]:undef;
  51 }
  52
  53 =item prepare_execute
  54
  55         $schema->prepare_execute($sql,@bind_vals)
  56
  57 Prepares and executes a statement
  58
  59 =cut
  60
  61 sub prepare_execute {
  62     my ($self,$sql,@bind_vals) = @_;
  63     $self->storage->
  64         dbh_do(sub {
  65                    my ($s,$dbh) = @_;
  66                    my $sth = $dbh->
  67                        prepare_cached($sql,
  68                       {dbi_dummy => __FILE__.__LINE__ })
  69                        or die "Unable to prepare statement: $sql";
  70                    $sth->execute(@bind_vals) or
  71                        die "Unable to execute statement: ".$dbh->errstr();
  72                    return $sth;
  73                });
  74 }
  75
  76 =item sql_file_in_txn
  77
  78 C<sql_file_in_txn();>
  79
  80
  81
  82 =cut
  83 sub sql_file_in_txn {
  84     my ($self,$fn) = @_;
  85     my $fh = open_compressed_file($fn) or
  86         die "Unable to open $fn for reading: $!";
  87     local $/;
  88     my $sql = <$fh>;
  89     defined($sql) or die "Unable to read from file: $!";
  90     $self->prepare_execute($sql);
  91 }
  92
  93
  94
  95 =back
  96
  97 =head2 Database Upgrade and Version
  98
  99 =over
 100
 101 =item db_version
 102
 103 C<db_version();>
 104
 105 Returns the current database version (integer)
 106
 107 =cut
 108 sub db_version {
 109     my ($self) = @_;
 110     return $self->select_one('SELECT db_version()');
 111 }
 112
 113 =item upgrades_to_run
 114
 115 C<upgrades_to_run();>
 116
 117 Returns the set of upgrades which will have to be run (in order) to upgrade the
 118 database to the current version
 119
 120 =cut
 121
 122 sub upgrades_to_run {
 123     my ($self,$deployment_dir) = @_;
 124
 125     my $current_version = $self->db_version();
 126
 127     my @files;
 128     File::Find::find(sub {
 129                          if (-f $_ and /^schema_(\d+)_to_(\d+)\.pl$/) {
 130                              push @files, {file => $File::Find::name,
 131                                            from => $1,
 132                                            to => $2,
 133                                           };
 134                          }
 135                      },
 136                      $deployment_dir
 137                     );
 138     # sort the upgrades
 139     use Data::Dumper;
 140     print STDERR Dumper(@files);
 141     @files = sort {$a->{from} <=> $b->{from}}
 142         # strip out upgrades which don't need to be run
 143         grep {$_->{from} >= $current_version } @files;
 144
 145     print STDERR Dumper(@files);
 146     return @files;
 147 }
 148
 149
 150
 151
 152 =back
 153
 154 =cut
 155
 156 1;
 157
 158
 159 __END__