First pass at adding key files
This commit is contained in:
dsainty
282
site/slowtwitch.com/cgi-bin/articles/admin/GT/SQL/Upgrade.pm
Normal file
282
site/slowtwitch.com/cgi-bin/articles/admin/GT/SQL/Upgrade.pm
Normal file
@ -0,0 +1,282 @@
|
||||
# ====================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::SQL::Upgrade
|
||||
# Author: Jason Rhinelander
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: Upgrade.pm,v 1.7 2008/09/23 23:55:26 brewt Exp $
|
||||
#
|
||||
# Copyright (c) 2005 Gossamer Threads Inc. All Rights Reserved.
|
||||
# ====================================================================
|
||||
#
|
||||
# Description:
|
||||
# Various commonly used SQL upgrade functions used by GT product upgrades.
|
||||
#
|
||||
|
||||
package GT::SQL::Upgrade;
|
||||
use strict;
|
||||
use vars qw/@ISA @EXPORT $VERSION/;
|
||||
require Exporter;
|
||||
|
||||
# You *must* bump this each time you change or fix any of the code this file or
|
||||
# it is guaranteed to cause problems:
|
||||
$VERSION = 1.01;
|
||||
|
||||
@ISA = 'Exporter';
|
||||
@EXPORT = qw/add_column alter_column drop_column add_index add_unique drop_index add_table recreate_table/;
|
||||
|
||||
# Adds a column. Takes 5 args:
|
||||
# Output coderef, database object, table name, column name, column definition
|
||||
# Returns the return of $editor->add_col
|
||||
sub add_column {
|
||||
my ($out, $db, $table, $col, $def) = @_;
|
||||
$out->("Adding column $col to $table table...\n");
|
||||
my $ret = $db->editor($table)->add_col($col => $def);
|
||||
$out->($ret ? "\tOkay!\n" : "\tCould not add column $col: $GT::SQL::error\n");
|
||||
$ret;
|
||||
}
|
||||
|
||||
# Changes a column. Takes 5 args:
|
||||
# Output coderef, database obj, table name, column name, new column definition
|
||||
sub alter_column {
|
||||
my ($out, $db, $table, $col, $def) = @_;
|
||||
$out->("Updating column definition for $col in $table table...\n");
|
||||
my $ret = $db->editor($table)->alter_col($col, $def);
|
||||
$out->($ret ? "\tOkay!\n" : "\tCould not alter column $col: $GT::SQL::error\n");
|
||||
$ret;
|
||||
}
|
||||
|
||||
# Drops a column. Takes 4 args:
|
||||
# Output coderef, database object, table name, column name
|
||||
# Returns the return of $editor->drop_col
|
||||
sub drop_column {
|
||||
my ($out, $db, $table, $col) = @_;
|
||||
$out->("Dropping column '$col' from table '$table'...\n");
|
||||
my $ret = $db->editor($table)->drop_col($col);
|
||||
$out->($ret ? "\tOkay!\n" : "\tCould not drop column $col: $GT::SQL::error\n");
|
||||
$ret;
|
||||
}
|
||||
|
||||
# Adds indexes. Takes 4-5 args
|
||||
# Output coderef, database object, table name, indexes hash reference, and an
|
||||
# optional boolean value to make the added indexes unique indexes.
|
||||
# Returns the return of $editor->add_index
|
||||
sub add_index {
|
||||
my ($out, $db, $table, $indexes, $unique) = @_;
|
||||
my $editor = $db->editor($table);
|
||||
my $cret = 1;
|
||||
while (my ($idx, $defn) = each %$indexes) {
|
||||
my ($meth, $index_display) = $unique ? (add_unique => 'unique index') : (add_index => 'index');
|
||||
$out->("Adding $index_display '$idx' to '$table' table...\n");
|
||||
my $ret = $editor->$meth($idx => $indexes->{$idx});
|
||||
$out->($ret ? "\tOkay!\n" : "\tCould not add $index_display '$idx': $GT::SQL::error\n");
|
||||
$cret = $ret unless $ret;
|
||||
}
|
||||
$cret;
|
||||
}
|
||||
|
||||
# A simple alias for add_index(..., 1);
|
||||
sub add_unique {
|
||||
push @_, 1;
|
||||
goto &add_index;
|
||||
}
|
||||
|
||||
# Drops an index. Takes 4-5 args:
|
||||
# Output coderef, GT::SQL obj, table name, index name, plus an optional boolean
|
||||
# value to indicate that the index to drop is a unique index.
|
||||
sub drop_index {
|
||||
my ($out, $db, $table, $index, $unique) = @_;
|
||||
$out->("Dropping index '$index' from '$table' table...\n");
|
||||
my $editor = $db->editor($table);
|
||||
my $meth = $unique ? 'drop_unique' : 'drop_index';
|
||||
my $ret = $editor->$meth($index);
|
||||
$out->($ret ? "\tOkay!\n" : "\tCould not drop index '$index': $GT::SQL::error\n");
|
||||
$ret;
|
||||
}
|
||||
|
||||
# Adds a table. Takes 3 base, plus unlimited extra arguments:
|
||||
# Output coderef, GT::SQL obj, table name
|
||||
# Other arguments are read in pairs - the first is a ::Creator method name, the
|
||||
# second is the value to pass to the method.
|
||||
sub add_table {
|
||||
my ($out, $db, $table) = splice @_, 0, 3;
|
||||
|
||||
$out->("Adding table '$table'...\n");
|
||||
my $c = $db->creator($table);
|
||||
|
||||
while (@_) {
|
||||
my ($meth, $arg) = splice @_, 0, 2;
|
||||
$c->$meth($arg);
|
||||
}
|
||||
|
||||
my $ret = $c->create;
|
||||
if ($ret) {
|
||||
$out->("\tOkay!\n");
|
||||
}
|
||||
else {
|
||||
$out->("\tAn error occurred: $GT::SQL::error\n");
|
||||
$c->set_defaults;
|
||||
$c->save_schema;
|
||||
}
|
||||
$ret;
|
||||
}
|
||||
|
||||
# Used when recreating a table is necessary (used in at least the Links SQL
|
||||
# 2.1.2 -> 2.2.0 upgrade) It creates a temporary table, copies all the data
|
||||
# into it, then drops the original table, recreates it, and copies all the data
|
||||
# back.
|
||||
# Usage:
|
||||
# recreate_table($out, $db, $table_name, $condition, ...ARGS...);
|
||||
# - $out is the code reference to call with output
|
||||
# - $db is the GT::SQL object for the database
|
||||
# - $table_name is the name of the table to recreated
|
||||
# - $condition is a code reference - it will be called with the table as an
|
||||
# argument. If it returns true, the table is recreated, otherwise (if it
|
||||
# returns false) recreating the table is skipped.
|
||||
# - Remaining arguments are specified in pairs - the first of each pair of
|
||||
# arguments is the function to call, the second is the argument to pass to
|
||||
# that function. At least a "cols => [ ... ]" pair must be specified.
|
||||
# Known problems:
|
||||
# - The code that copies any custom columns breaks if any columns have been
|
||||
# removed from the new table has fewer columns from the old one - those
|
||||
# columns will be copied to the new table.
|
||||
# - A change adding not_null to a column will only work for INT's/FLOAT's,
|
||||
# for which any previous null values are given a value of 0.
|
||||
sub recreate_table {
|
||||
my ($out, $db, $table_name, $condition) = splice @_, 0, 4;
|
||||
@_ % 2 == 0 or die "Invalid arguments. Usage: recreate_table(INSTALLER_OBJ, GTSQL_OBJ, 'Table', method => val, method => val, ...)";
|
||||
my @args = @_;
|
||||
my %args = @args;
|
||||
my @cols = $args{cols};
|
||||
my %cols = @cols;
|
||||
|
||||
my $table = $db->table($table_name);
|
||||
|
||||
my $success;
|
||||
if ($condition->($table)) {
|
||||
RECREATE: {
|
||||
$out->("Performing required $table_name table recreation...\n");
|
||||
|
||||
$out->("\t- Creating temporary storage table...\n");
|
||||
my @create;
|
||||
my %old_cols = $table->cols;
|
||||
my %new_cols = @{$args{cols}};
|
||||
|
||||
my ($count, @denull) = 0;
|
||||
for (keys %old_cols) {
|
||||
if (
|
||||
!$old_cols{$_}->{not_null} and # Didn't have not_null before
|
||||
$new_cols{$_} and # Still exists in the new version of the table
|
||||
$new_cols{$_}->{not_null} and # not_null present in the new version
|
||||
$new_cols{$_}->{type} =~ /^(?:FLOAT|DOUBLE|DECIMAL|\w*INT)$/ # is a numeric type
|
||||
) {
|
||||
push @denull, $count;
|
||||
}
|
||||
$count++;
|
||||
}
|
||||
|
||||
# Retain any custom columns:
|
||||
for (keys %old_cols) {
|
||||
unless ($cols{$_}) {
|
||||
push @create, $_ => $old_cols{$_};
|
||||
push @cols, $_ => $old_cols{$_};
|
||||
$cols{$_} = $old_cols{$_};
|
||||
}
|
||||
}
|
||||
|
||||
my $c = $db->creator($table_name . '_tmp');
|
||||
$c->cols(@create);
|
||||
|
||||
# We should probably 'force' the following create, but that is
|
||||
# potentially dangerous if the main table isn't recreated properly.
|
||||
my $ret = $c->create;
|
||||
if ($ret) {
|
||||
$out->("\t\tOkay!\n");
|
||||
}
|
||||
else {
|
||||
$out->("\t\tAn error occurred: $GT::SQL::error\n");
|
||||
last RECREATE;
|
||||
}
|
||||
|
||||
my $tmp_table = $db->table($table_name . '_tmp');
|
||||
|
||||
$out->("\t- Copying existing data to temporary table...\n");
|
||||
my $sth = $table->select(keys %old_cols);
|
||||
my @recs;
|
||||
while () {
|
||||
my $row = $sth->fetchrow_arrayref;
|
||||
if ($row) {
|
||||
my @row = @$row;
|
||||
for (@denull) {
|
||||
$row[$_] = 0 if not defined $row[$_];
|
||||
}
|
||||
push @recs, \@row;
|
||||
}
|
||||
if (!$row or @recs >= 1000) {
|
||||
$ret = $tmp_table->insert_multiple([keys %old_cols], @recs) if @recs;
|
||||
$out->("\t\tAn error occurred: $GT::SQL::error\n") unless $ret;
|
||||
@recs = ();
|
||||
last if !$row;
|
||||
}
|
||||
}
|
||||
$out->("\t\tOkay!\n");
|
||||
|
||||
$out->("\t- Dropping $table_name table...\n");
|
||||
$ret = $db->editor($table_name)->drop_table;
|
||||
if ($ret) {
|
||||
$out->("\t\tOkay!\n");
|
||||
}
|
||||
else {
|
||||
$out->("\t\tAn error occurred: $GT::SQL::error\n");
|
||||
}
|
||||
|
||||
$out->("\t- Creating new $table_name table...\n");
|
||||
$c = $db->creator($table_name);
|
||||
while (@args) {
|
||||
my ($method, $value) = (shift @args, shift @args);
|
||||
$c->$method($value);
|
||||
}
|
||||
|
||||
$ret = $c->create('force');
|
||||
if ($ret) {
|
||||
$out->("\t\tOkay!\n");
|
||||
}
|
||||
else {
|
||||
$out->("\t\tAn error occurred: $GT::SQL::error\n");
|
||||
last RECREATE;
|
||||
}
|
||||
|
||||
$out->("\t- Copying temporary data back into new table...\n");
|
||||
$sth = $tmp_table->select(keys %old_cols);
|
||||
@recs = ();
|
||||
while () {
|
||||
my $row = $sth->fetchrow_arrayref;
|
||||
push @recs, [@$row] if $row;
|
||||
if (!$row or @recs >= 1000) {
|
||||
$ret = $table->insert_multiple([keys %old_cols], @recs) if @recs;
|
||||
$out->("\t\tAn error occurred: $GT::SQL::error\n") unless $ret;
|
||||
@recs = ();
|
||||
last if !$row;
|
||||
}
|
||||
}
|
||||
$out->("\t\tOkay!\n");
|
||||
|
||||
$out->("\t- Dropping ${table_name}_tmp table...\n");
|
||||
$ret = $db->editor("${table_name}_tmp")->drop_table;
|
||||
if ($ret) {
|
||||
$out->("\t\tOkay!\n");
|
||||
}
|
||||
else {
|
||||
$out->("\t\tAn error occurred: $GT::SQL::error\n");
|
||||
}
|
||||
|
||||
$success = 1;
|
||||
}
|
||||
|
||||
if (!$success) {
|
||||
$out->("\tAn error occurred while attempting to recreate $table_name. Procedure aborted.\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user