File Coverage

blib/lib/DBIx/Migrate.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package DBIx::Migrate;

use strict;
use Carp;
use vars qw( $VERSION );
use DBI;
use Data::Dumper;

$VERSION=0.01;

my $data_types = {
qw!
1 char
2 numeric
3 decimal
4 integer
5 smallint
6 float
7 real
8 double
9 date
10 time
11 timestamp
12 varchar
-1 text
-2 binary
-3 varbinary
-4 blob
-5 bigint
-6 tinyint
-7 bit
-8 wchar
-9 wvarchar
-10 wlongvarchar
! };

# Constructor
sub new {
    my($class, %parm) = @_;
    croak 'Expecting a class' if ref $class;

## don't overwrite target table if it already exists
    my $self = { CLOBBER => 0,
                 TYPE_TRANSLATE => $data_types
               };

## the lazy method
    while(my($k, $v) = each(%parm)) { $self->{$k} = $v};

## retrieve all tables in source database
    unless(%{ $self->{SOURCE_TABLES} } = map { $_ => 1 } $self->{SOURCE}->tables) {
      croak('no tables in source database');
    }

#  croak if requested source table doesn't exist
    for (@{ $self->{TABLES} }) {
        croak("source table: $_ not found")
          unless exists($self->{SOURCE_TABLES}{$_});
    }

## retrieve all tables in target database
    if( $self->{TARGET}->tables ) {
        %{ $self->{TARGET_TABLES} } = map { $_ => 1 } $self->{TARGET}->tables;
    }

## check CLOBBER and croak if table already exists target database
    my @common = ();
    for (keys %{ $self->{SOURCE_TABLES} } ) {
        push(@common, $_) if exists $self->{TARGET_TABLES}{$_};
    }
    if( @common && !($self->{CLOBBER}) ) {
        croak("@common target table(s) already exist; set CLOBBER to overwrite");
    }
    bless $self, $class;
    return $self;
}

sub migrate {
    my ($self, %parm) = @_;
    my ($source, $target, $tbl_count);
## the lazy method
    while(my($k, $v) = each(%parm)) { $self->{$k} = $v };
    for my $table (@{ $self->{TABLES} })
    {
        $source = $self->{SOURCE}->prepare("SELECT * from $table");
        $source->execute();

## Guess data types and precision of source table
        my $create = "CREATE TABLE $table (\n";
        for( my $i=0; $i <= $source->{NUM_OF_FIELDS}; $i++) {
            next unless( $source->{NAME}->[$i] &&
                         $source->{TYPE}->[$i] &&
                         $source->{PRECISION}->[$i]
                       );
            $create .= "$source->{NAME}->[$i] $self->{TYPE_TRANSLATE}{$source->{TYPE}->[$i]}";
            $create .= "($source->{PRECISION}->[$i])" unless($source->{TYPE}->[$i] == 9);

            $create .= " NOT NULL" unless($source->{NULLABLE}->[$i]);
            if ( $source->{NAME}->[$i+1] &&
                 $source->{TYPE}->[$i+1] &&
                 $source->{PRECISION}->[$i+1]
               )
            {
                $create .= ",\n";
            }
        }
        $create .= "\n)";

## Create target table using approximate data types and precision
## WARNING: TARGET TABLE IS DROPPED IF IT ALREADY EXISTS!
        $self->{TARGET}->do("DROP TABLE $table")
          if(exists($self->{TARGET_TABLES}{$table}));
        $self->{TARGET}->do($create);

## Create insertion fields
        my $fields = join(',', @{ $source->{NAME} });
        my $qmarks = join(',', (map { '?' } @{ $source->{NAME} }));
        $source->finish();

my $select = qq!
SELECT $fields
FROM $table
!;

my $insert = qq!
INSERT INTO $table ($fields)
VALUES ($qmarks)
!;

        $source = $self->{SOURCE}->prepare($select);
        $target = $self->{TARGET}->prepare($insert);

        $source->execute();

        while (my $rows = $source->fetchrow_arrayref) {
            $target->execute(@{$rows});
        }
        $source->finish();
        $target->finish();
        $tbl_count++;
    }
    return $tbl_count;
}

1;
__END__