Changeset 14975 for lang/perl/Archer

Show
Ignore:
Timestamp:
07/01/08 10:48:45 (5 months ago)
Author:
tokuhirom
Message:

i think, SQL::Translator is too slow.

Files:
1 modified

Legend:

Unmodified
Added
Removed

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

    r11268 r14975  
    33use warnings; 
    44use base qw/Archer::Plugin/; 
    5 use SQL::Translator; 
    6 use SQL::Translator::Diff; 
    7 use SQL::Translator::Parser::MySQL; 
    8 use Path::Class; 
     5use MySQL::Diff; 
    96 
    107sub run { 
    … …  
    129 
    1310    my $config = "$self->{project}::Config"; 
    14     $config->use or die $@; 
     11    $config->use or die; 
     12 
    1513    return unless $config->can('_new_instance'); 
    1614 
    17     my $src = $self->_src_schema; 
     15    my $dev = $self->_db($config->_new_instance->datasource); 
     16    local $ENV{SLEDGE_CONFIG_NAME} = '_product'; 
     17    my $product = $self->_db($config->_new_instance->datasource); 
    1818 
    19     local $ENV{SLEDGE_CONFIG_NAME} = '_product'; 
    20     my $production = $self->_production_db($config->_new_instance->{datasource}); 
    21  
    22     my $diff = SQL::Translator::Diff->new( 
    23         { 
    24             output_db       => 'MySQL', 
    25             source_schema   => $src, 
    26             target_schema   => $production, 
    27             target_db       => 'MySQL', 
    28             no_batch_alters => 1, 
    29         } 
    30     )->compute_differences->produce_diff_sql; 
    31  
    32     print STDERR $diff; 
     19    print MySQL::Diff::diff_dbs({}, $product, $dev); 
    3320} 
    3421 
    35 sub _src_schema { 
    36     my $self = shift; 
    37     my $work_dir = Archer->context->{ config }->{ global }->{ work_dir }; 
     22sub _db { 
     23    my ($self, $drv, $user, $pass) = @_; 
    3824 
    39     my $src = file( $work_dir, $self->{project}, $self->l_project, 'db', 'schema.sql' )->slurp; 
    40     $src =~ s/\s+COMMENT\s+['"][^'"]+['"]\s*//gi;    # SQL::Translator cannot parse comments. 
     25    my $db = ($drv =~ /^dbi:[^:]+:([^:;=]+)/) ? $1 : ''; 
     26    my $host = ($drv =~ /hostname=([a-zA-Z_0-9.]+)/) ? $1 : ''; 
    4127 
    42     my $t = SQL::Translator->new(); 
    43     $t->parser('SQL::Translator::Parser::MySQL'); 
    44     $t->translate( \$src ); 
    45  
    46     my $schema = $t->schema; 
    47     $schema->name('schema.sql'); 
    48     $schema; 
    49 } 
    50  
    51 sub _production_db { 
    52     my ($self, $dsn) = @_; 
    53  
    54     if ( scalar @$dsn == 4 ) { 
    55         pop @$dsn; # dbic stuff 
    56     } 
    57  
    58     my $dbh = DBI->connect( 
    59         @$dsn, 
    60         { 
    61             RaiseError       => 1, 
    62             FetchHashKeyName => 'NAME_lc', 
    63         } 
     28    return MySQL::Database->new( 
     29        auth => 
     30          { user => $user, password => $pass, host => $host }, 
     31        db => $db, 
    6432    ); 
    65  
    66     my $t = SQL::Translator->new( 
    67         parser => 'DBI', 
    68         no_comments => 1, 
    69         parser_args => { 
    70             dbh    => $dbh, 
    71         } 
    72     ); 
    73     $t->translate; 
    74  
    75     my $schema = $t->schema or die $t->error; 
    76     $schema->name($dsn->[0]); 
    77     $schema; 
    7833} 
    7934