branches/0.4.3/SrSv/DB/Schema.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU General Public License as published by
   5 #       the Free Software Foundation; either version 2 of the License, or
   6 #       (at your option) any later version.
   7 #
   8 #       SurrealServices is distributed in the hope that it will be useful,
   9 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #       GNU General Public License for more details.
  12 #
  13 #       You should have received a copy of the GNU General Public License
  14 #       along with SurrealServices; if not, write to the Free Software
  15 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package SrSv::DB::Schema;
  18
  19 use strict;
  20
  21 use SrSv::MySQL qw( $dbh connectDB disconnectDB );
  22 use SrSv::Conf2Consts qw( sql );
  23
  24 BEGIN {
  25         *PREFIX = \&main::PREFIX;
  26 }
  27
  28
  29 use Exporter 'import';
  30 BEGIN {
  31         our @EXPORT = qw(
  32                 upgrade_schema check_schema find_newest_schema
  33                 do_sql_file );
  34 };
  35
  36 sub find_newest_schema() {
  37         opendir((my $dh), "@{[PREFIX]}/sql/");
  38         my @schemas;
  39         while (my $dentry = readdir($dh)) {
  40                 next if ($dentry =~ /^\.\.?$/);
  41                 if($dentry =~ /^(\d+)\.sql$/) {
  42                         push @schemas, $1;
  43                 }
  44         }
  45         @schemas = reverse sort { $a <=> $b } @schemas;
  46         return $schemas[0];
  47 }
  48 sub upgrade_schema($) {
  49         my ($ver) = @_;
  50         opendir((my $dh), "@{[PREFIX]}/sql/");
  51         my @schemas;
  52         while (my $dentry = readdir($dh)) {
  53                 next if ($dentry =~ /^\.\.?$/);
  54                 if($dentry =~ /^(\d+)\.sql$/) {
  55                         push @schemas, $1;
  56                 }
  57         }
  58         @schemas = sort { $a <=> $b } @schemas;
  59         while(scalar(@schemas) && $schemas[0] <= $ver) {
  60                 shift @schemas;
  61         }
  62         foreach my $schema (@schemas) {
  63                 #print "@{[PREFIX]}/sql/${schema}.sql\n";
  64                 do_sql_file("@{[PREFIX]}/sql/${schema}.sql");
  65         }
  66 }
  67 sub check_schema() {
  68         my $disconnect = 0;
  69         if(!defined($dbh)) {
  70                 connectDB();
  71                 $disconnect = 1;
  72         }
  73         # SHOW TABLES WHERE doesn't work for MySQL 4.x.
  74         my $tables = $dbh->selectall_arrayref("SHOW TABLES");
  75         my ($found, undef) = grep { m"srsv_schema" } map { $_->[0] } @$tables;
  76         if(defined $found) {
  77         } else {
  78                 return 0;
  79         }
  80         my $findSchemaVer = $dbh->prepare("SELECT `ver` FROM `srsv_schema`");
  81         $findSchemaVer->execute();
  82         my ($ver) = $findSchemaVer->fetchrow_array();
  83         $findSchemaVer->finish();
  84         disconnectDB() if $disconnect;
  85         return $ver;
  86 }
  87
  88 sub do_sql_file($) {
  89         my $file = shift;
  90         open ((my $SQL), $file) or die "$file: $!\n";
  91         my $sql;
  92
  93         while(my $x = <$SQL>) {
  94                 unless($x =~ /^#/ or $x eq $/) {
  95                         $sql .= "$x$/";
  96                 }
  97         }
  98         foreach my $line (split(/;/s, $sql)) {
  99                 $dbh->do($line);
 100         }
 101 }
 102
 103 1;