root/lang/perl/Archer/trunk/lib/Archer/Plugin/MySQLDiff/Sledge.pm @ 11268

Revision 11268, 2.1 kB (checked in by tokuhirom, 7 years ago)

use SQL::Translator.

Line 
1package Archer::Plugin::MySQLDiff::Sledge;
2use strict;
3use warnings;
4use base qw/Archer::Plugin/;
5use SQL::Translator;
6use SQL::Translator::Diff;
7use SQL::Translator::Parser::MySQL;
8use Path::Class;
9
10sub run {
11    my $self = shift;
12
13    my $config = "$self->{project}::Config";
14    $config->use or die $@;
15    return unless $config->can('_new_instance');
16
17    my $src = $self->_src_schema;
18
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;
33}
34
35sub _src_schema {
36    my $self = shift;
37    my $work_dir = Archer->context->{ config }->{ global }->{ work_dir };
38
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.
41
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
51sub _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        }
64    );
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;
78}
79
801;
81__END__
82
83=head1 NAME
84
85Archer::Plugin::MySQLDiff::Sledge - show the mysqldiff, with sledge's configuration class.
86
87=head1 SYNOPSIS
88
89  - module: MySQLDiff::Sledge
90
91=head1 DESCRIPTION
92
93=head1 AUTHORS
94
95Tokuhiro Matsuno.
96
97=cut
98
Note: See TracBrowser for help on using the browser.