Changeset 11268 for lang/perl/Archer

Timestamp:

05/08/08 12:45:43 (7 months ago)

Author:

tokuhirom

Message:

use SQL::Translator.

Files:

• lang/perl/Archer/trunk/lib/Archer/Plugin/MySQLDiff/Sledge.pm (modified) (2 diffs)

lang/perl/Archer/trunk/lib/Archer/Plugin/MySQLDiff/Sledge.pm

@@ -3 +3 @@
 use warnings;
 use base qw/Archer::Plugin/;
-use MySQL::Diff;
+use SQL::Translator;
+use SQL::Translator::Diff;
+use SQL::Translator::Parser::MySQL;
+use Path::Class;
 
 sub run {
@@ -9 +12 @@
 
     my $config = "$self->{project}::Config";
-    $config->use or die;
-
+    $config->use or die $@;
     return unless $config->can('_new_instance');
 
-    my $dev = $self->_db($config->_new_instance->datasource);
+    my $src = $self->_src_schema;
+
     local $ENV{SLEDGE_CONFIG_NAME} = '_product';
-    my $product = $self->_db($config->_new_instance->datasource);
+    my $production = $self->_production_db($config->_new_instance->{datasource});
 
-    print MySQL::Diff::diff_dbs({}, $product, $dev);
+    my $diff = SQL::Translator::Diff->new(
+        {
+            output_db       => 'MySQL',
+            source_schema   => $src,
+            target_schema   => $production,
+            target_db       => 'MySQL',
+            no_batch_alters => 1,
+        }
+    )->compute_differences->produce_diff_sql;
+
+    print STDERR $diff;
 }
 
-sub _db {
-    my ($self, $drv, $user, $pass) = @_;
+sub _src_schema {
+    my $self = shift;
+    my $work_dir = Archer->context->{ config }->{ global }->{ work_dir };
 
-    my $db = ($drv =~ /^dbi:[^:]+:([^:;=]+)/) ? $1 : '';
-    my $host = ($drv =~ /hostname=([a-zA-Z_0-9.]+)/) ? $1 : '';
+    my $src = file( $work_dir, $self->{project}, $self->l_project, 'db', 'schema.sql' )->slurp;
+    $src =~ s/\s+COMMENT\s+['"][^'"]+['"]\s*//gi;    # SQL::Translator cannot parse comments.
 
-    return MySQL::Database->new(
-        auth =>
-          { user => $user, password => $pass, host => $host },
-        db => $db,
+    my $t = SQL::Translator->new();
+    $t->parser('SQL::Translator::Parser::MySQL');
+    $t->translate( \$src );
+
+    my $schema = $t->schema;
+    $schema->name('schema.sql');
+    $schema;
+}
+
+sub _production_db {
+    my ($self, $dsn) = @_;
+
+    if ( scalar @$dsn == 4 ) {
+        pop @$dsn; # dbic stuff
+    }
+
+    my $dbh = DBI->connect(
+        @$dsn,
+        {
+            RaiseError       => 1,
+            FetchHashKeyName => 'NAME_lc',
+        }
     );
+
+    my $t = SQL::Translator->new(
+        parser => 'DBI',
+        no_comments => 1,
+        parser_args => {
+            dbh    => $dbh,
+        }
+    );
+    $t->translate;
+
+    my $schema = $t->schema or die $t->error;
+    $schema->name($dsn->[0]);
+    $schema;
 }