Raw content of SchemaConverter
<![CDATA[# Module to ease mysql schema conversion
# Author: Arne Stabenau
# Usage:
# Make a schema_converter with new ( source_dbh, target_dbh )
# source database should be filled, target is empty schema
# For each target table there will be a transfer
# Either with a self specified transfer function
# with a custom select
# from a renamed source table
# from the same name source table
# configure the transfer (and the order) with
# table_rename( "oldname", "newname" )
# table_skip( "tablename" )
# do_first( "newtable1", "newtable2", "newtable3" )
# Each standard table transfer
# Either do a custom select statement
# or transfer columns with same name or renamed into each other
# specify columns to omit in target or get error
# column_rename( "tablename", "oldcolname", "newcolname" )
# column_skip( $targetdb, "table", "column" )
# custom_select( $targetdb, "tablename",
# Each row may be modified (custom select or standard select)
# specify a row_modifier function for the target table
# It takes a list ref and returns a list ref with the modified values
# ( you have to know the order of columns which come in have to go out db )
# set_row_modifier( "tablename", function_reference )
#
# potentially large (target) tables should be declared with
# big_table( "newtablename" );
package SchemaConverter;
use strict;
use DBI;
use Data::Dumper;
sub new {
my ( $class, @args ) = @_;
my $self = {};
bless $self, $class;
$self->source_dbh( $args[0] );
$self->target_dbh( $args[1] );
$self->read_dbs();
return $self;
}
sub tmp_dir {
my ( $self, $arg ) = @_;
( defined $arg ) &&
( $self->{'tmp_dir'} = $arg );
return $self->{'tmp_dir'};
}
sub source_dbh {
my ( $self, $arg ) = @_;
( defined $arg ) &&
( $self->{'source_dbh'} = $arg );
return $self->{'source_dbh'};
}
sub target_dbh {
my ( $self, $arg ) = @_;
( defined $arg ) &&
( $self->{'target_dbh'} = $arg );
return $self->{'target_dbh'};
}
sub close_dbh {
my $self = shift;
$self->source_dbh()->disconnect();
$self->target_dbh()->disconnect();
}
sub transfer {
my $self = shift;
local *FH;
my $tmpdir;
if( ! defined $self->tmp_dir() ) {
$self->close_dbh();
die( "No tmp_dir specified" );
} else {
$tmpdir = $self->tmp_dir();
}
# first we should check if all standard trnasfers can go
# otherwise testing this is a pain
$self->check_possible_transfer();
my @ordered_tables = $self->{targetdb}{dofirst};
my %all_tables = %{$self->{targetdb}{tables}};
for my $tablename ( @ordered_tables ) {
delete $all_tables{$tablename};
}
for my $tablename ( keys %all_tables ) {
push( @ordered_tables, $tablename );
}
for my $tablename ( @ordered_tables ) {
my $skip = 0;
print STDERR "Transfer $tablename ";
open( FH, ">$tmpdir/$tablename.txt" ) or die "cant open dumpfile";
if( exists $self->{targetdb}{tables}{$tablename}{transfer} ) {
my $transfunc = $self->{targetdb}{tables}{$tablename}{transfer};
&$transfunc( $self->source_dbh(), $self->target_dbh(), $tablename, \*FH );
} else {
my $sourcetable;
if( exists $self->{targetdb}{tables}{$tablename}{link} ) {
$sourcetable = $self->{targetdb}{tables}{$tablename}{link};
if( $sourcetable eq "" ) {
# skip this table
$skip = 1;
}
} else {
# find the sourcetable
if( exists $self->{targetdb}{tables}{$tablename}{select} ) {
# if we have custom select, sourcetable doesnt make sense
$sourcetable = undef;
} elsif( ! exists $self->{sourcedb}{tables}{$tablename} ) {
die "Couldnt find source for $tablename. Enter empty sourcetable.";
} else {
$sourcetable = $tablename;
}
}
if( ! $skip ) {
$self->standard_table_transfer( $sourcetable, $tablename, \*FH );
}
}
close FH;
if( ! $skip ) {
$self->target_dbh->do( "load data infile '$tmpdir/$tablename.txt' into table $tablename" );
}
# upload ?
unlink "$tmpdir/$tablename.txt";
print STDERR " finished\n";
}
# close databases
}
# this function checks if a standard transfer is possible.
# custom selects and custom transfer functions are not checked
# it will only return if it can do the transfer otherwise die
sub check_possible_transfer {
my $self = shift;
for my $tablename ( keys %{$self->{targetdb}{tables}} ) {
my $sourcetable;
if( exists $self->{targetdb}{tables}{$tablename}{transfer} ) {
next;
}
if( exists $self->{targetdb}{tables}{$tablename}{link} ) {
$sourcetable = $self->{targetdb}{tables}{$tablename}{link};
if( $sourcetable eq "" ) {
# skip this table
next;
}
} else {
# find the sourcetable
if( exists $self->{targetdb}{tables}{$tablename}{select} ) {
# custom select, no check
next;
} elsif( ! exists $self->{sourcedb}{tables}{$tablename} ) {
die "Couldnt find source for $tablename. Enter empty sourcetable.";
} else {
$sourcetable = $tablename;
}
}
my @newcols = @{$self->{targetdb}{tables}{$tablename}{columns}};
my @oldcols = @{$self->{sourcedb}{tables}{$sourcetable}{columns}};
my %rename;
if( exists $self->{targetdb}{tables}{$tablename}{columnrename} ) {
%rename = %{$self->{targetdb}{tables}{$tablename}{columnrename}};
} else {
%rename = ();
}
# find all source columns and build select statement
for my $colname ( @newcols ) {
my $selname;
if( exists $rename{$colname} ) {
$selname = $rename{$colname};
if( $selname eq "" ) {
$selname = "NULL";
}
} else {
my $colExists = 0;
for my $oldcol ( @oldcols ) {
if( $oldcol eq $colname ) {
$selname = $colname;
$colExists = 1;
last;
}
}
if( ! $colExists ) {
die "Couldnt fill $tablename.$colname\n";
}
}
}
}
}
sub standard_table_transfer {
my ( $self, $sourcetable, $targettable, $tmpfile ) = @_;
my $sourcedb = $self->source_dbh();
my $targetdb = $self->target_dbh();
# look for custom select
my $select = "";
if( exists $self->{targetdb}{tables}{$targettable}{select} ) {
$select = $self->{targetdb}{tables}{$targettable}{select};
} else {
# check if all columns have matching names
my @newcols = @{$self->{targetdb}{tables}{$targettable}{columns}};
my @oldcols = @{$self->{sourcedb}{tables}{$sourcetable}{columns}};
my %rename;
if( exists $self->{targetdb}{tables}{$targettable}{columnrename} ) {
%rename = %{$self->{targetdb}{tables}{$targettable}{columnrename}};
} else {
%rename = ();
}
# find all source columns and build select statement
for my $colname ( @newcols ) {
my $selname;
if( exists $rename{$colname} ) {
$selname = $rename{$colname};
if( $selname eq "" ) {
$selname = "NULL";
}
} else {
my $colExists = 0;
for my $oldcol ( @oldcols ) {
if( $oldcol eq $colname ) {
$selname = $colname;
$colExists = 1;
last;
}
}
if( ! $colExists ) {
die "Couldnt fill $targettable.$colname\n";
}
}
$select .= " $selname,";
}
chop( $select );
$select = "SELECT $select from $sourcetable";
}
# MySQL specific ...
# DBD doesn't use cursors; loads whole table during execute()
# problem for large tables - "mysql_use_result" gets around this
my $sth;
if (defined $self->{targetdb}{tables}{$targettable}{its_a_big_un}) {
$sth = $self->source_dbh()->prepare( $select , { mysql_use_result => 1 } );
}
else {
$sth = $self->source_dbh()->prepare( $select );
}
$sth->execute();
my $row;
if( exists $self->{targetdb}{tables}{$targettable}{row_modify} ) {
my $rowmod = $self->{targetdb}{tables}{$targettable}{row_modify};
while( my $arref = $sth->fetchrow_arrayref() ) {
$row = &{$rowmod}($arref);
print $tmpfile ( join( "\t",@{$row} ),"\n" );
}
} else {
while( my $arref = $sth->fetchrow_arrayref() ) {
$row = join( "\t", @$arref );
print $tmpfile "$row\n";
}
}
}
sub read_dbs {
my $self = shift;
my $dbh;
for my $db_name ('targetdb', 'sourcedb' ) {
if( $db_name eq 'targetdb' ) {
$dbh = $self->target_dbh();
} else {
$dbh = $self->source_dbh();
}
my $sth = $dbh->prepare( "show tables" );
$sth->execute();
while( my $arref = $sth->fetchrow_arrayref() ) {
$self->{$db_name}{tables}{$arref->[0]} = {};
}
my @tables = keys %{$self->{$db_name}{tables}};
for my $table ( @tables ) {
$sth = $dbh->prepare( "show columns from $table" );
$sth->execute();
while( my $arref = $sth->fetchrow_arrayref () ) {
push( @{$self->{$db_name}{tables}{$table}{columns}}, $arref->[0] );
}
}
}
}
sub table_rename {
my ( $self, $oldtable, $newtable ) = @_;
$self->{targetdb}{tables}{$newtable}{link} = $oldtable;
}
sub table_skip {
my ( $self, $newtable ) = @_;
$self->{targetdb}{tables}{$newtable}{link} = "";
}
sub column_rename {
my ( $self, $newtable, $oldcol, $newcol ) = @_;
$self->{targetdb}{tables}{$newtable}{columnrename}{$newcol} = $oldcol;
}
sub column_skip {
my ( $self, $newtable, $newcol ) = @_;
$self->{targetdb}{tables}{$newtable}{columnrename}{$newcol} = "";
}
sub custom_select {
my ( $self, $newtable, $select ) = @_;
$self->{targetdb}{tables}{$newtable}{select} = $select;
}
sub set_row_modifier {
my ( $self, $newtable, $row_modifier ) = @_;
$self->{targetdb}{tables}{$newtable}{row_modify} = $row_modifier;
}
sub clear_target {
my $self = shift;
for my $tablename ( keys %{$self->{targetdb}{tables}} ) {
$self->target_dbh()->do( "delete from $tablename" );
}
}
sub big_table {
my ( $self, $table ) = @_;
$self->{targetdb}{tables}{$table}{its_a_big_un} = 1;
}
sub do_first {
my $self = shift;
my @ordered_table_list= @_;
$self->{targetdb}{dofirst} = \@ordered_table_list;
}
1;
]]>