t/60roundtrip.t

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use Test::More qw/no_plan/;
   6 use Test::Exception;
   7 use FindBin qw/$Bin/;
   8
   9 use SQL::Translator;
  10
  11 ### Set $ENV{SQLTTEST_RT_DEBUG} = 1 for more output
  12
  13 # What tests to run - parser/producer name, and optional args
  14 my $plan = [
  15   {
  16     engine => 'SQLite',
  17     producer_args => {},
  18     parser_args => {},
  19   },
  20   {
  21     engine => 'MySQL',
  22     producer_args => {},
  23     parser_args => {},
  24   },
  25   {
  26     engine => 'MySQL',
  27     name => 'MySQL 5.0',
  28     producer_args => { mysql_version => 5 },
  29     parser_args => { mysql_parser_version => 5 },
  30   },
  31   {
  32     engine => 'MySQL',
  33     name => 'MySQL 5.1',
  34     producer_args => { mysql_version => '5.1' },
  35     parser_args => { mysql_parser_version => '5.1' },
  36   },
  37   {
  38     engine => 'PostgreSQL',
  39     producer_args => {},
  40     parser_args => {},
  41   },
  42   {
  43     engine => 'Oracle',
  44     producer_args => {},
  45     parser_args => {},
  46   },
  47   {
  48     engine => 'SQLServer',
  49     producer_args => {},
  50     parser_args => {},
  51   },
  52   {
  53     engine => 'Sybase',
  54     producer_args => {},
  55     parser_args => {},
  56   },
  57   {
  58     engine => 'DB2',
  59     producer_args => {},
  60     parser_args => {},
  61   },
  62
  63 # There is no Access producer
  64 #  {
  65 #    engine => 'Access',
  66 #    producer_args => {},
  67 #    parser_args => {},
  68 #  },
  69 ];
  70
  71
  72 # This data file has the right mix of table/view/procedure/trigger
  73 # definitions, and lists enough quirks to trip up most combos
  74 # I am not sure if augmenting it will break other tests - experiment
  75 my $base_file = "$Bin/data/xml/schema.xml";
  76
  77 my $base_t = SQL::Translator->new;
  78 $base_t->$_ (1) for qw/add_drop_table no_comments/;
  79
  80 my $base_schema = $base_t->translate (
  81   parser => 'XML',
  82   file => $base_file,
  83 ) or die $base_t->error;
  84
  85
  86 for my $args (@$plan) {
  87
  88   $args->{name} ||= $args->{engine};
  89
  90   lives_ok (
  91     sub { check_roundtrip ($args, $base_schema) },
  92     "Round trip for $args->{name} did not throw an exception",
  93   );
  94 }
  95
  96
  97 sub check_roundtrip {
  98   my ($args, $base_schema) = @_;
  99   my $base_t = $base_schema->translator;
 100
 101 # create some sql from the submitted schema
 102   my $base_sql = $base_t->translate (
 103     data => $base_schema,
 104     producer => $args->{engine},
 105     producer_args => $args->{producer_args},
 106   );
 107
 108   like (
 109     $base_sql,
 110     qr/^\s*CREATE TABLE/m,  #assume there is at least one create table statement
 111     "Received some meaningful output from the first $args->{name} production",
 112   ) or do {
 113     diag ( _gen_diag ($base_t->error) );
 114     return;
 115   };
 116
 117 # parse the sql back
 118   my $parser_t = SQL::Translator->new;
 119   $parser_t->$_ (1) for qw/add_drop_table no_comments/;
 120   my $mid_schema = $parser_t->translate (
 121     data => $base_sql,
 122     parser => $args->{engine},
 123     parser_args => $args->{parser_args},
 124   );
 125
 126   isa_ok ($mid_schema, 'SQL::Translator::Schema', "First $args->{name} parser pass produced a schema:")
 127     or do {
 128       diag (_gen_diag ( $parser_t->error, $base_sql ) );
 129       return;
 130     };
 131
 132 # schemas should be comparable at least as far as table/field numbers go
 133   is_deeply (
 134     _get_table_info ($mid_schema->get_tables),
 135     _get_table_info ($base_schema->get_tables),
 136     "Schema tables generally match afer $args->{name} parser trip",
 137   ) or return;
 138
 139 # and produce sql once again
 140
 141 # Producing a schema with a Translator different from the one the schema was generated
 142 # from does not work. This is arguably a bug, 61translator_agnostic.t works with that
 143 #  my $producer_t = SQL::Translator->new;
 144 #  $producer_t->$_ (1) for qw/add_drop_table no_comments/;
 145
 146 #  my $rt_sql = $producer_t->translate (
 147 #    data => $mid_schema,
 148 #    producer => $args->{engine},
 149 #    producer_args => $args->{producer_args},
 150 #  );
 151
 152   my $rt_sql = $parser_t->translate (
 153     data => $mid_schema,
 154     producer => $args->{engine},
 155     producer_args => $args->{producer_args},
 156   );
 157
 158   like (
 159     $rt_sql,
 160     qr/^\s*CREATE TABLE/m,  #assume there is at least one create table statement
 161     "Received some meaningful output from the second $args->{name} production",
 162   ) or do {
 163     diag ( _gen_diag ( $parser_t->error ) );
 164     return;
 165   };
 166
 167 # the two sql strings should be identical
 168   my $msg = "$args->{name} SQL roundtrip successful - SQL statements match";
 169   $ENV{SQLTTEST_RT_DEBUG}
 170     ? is_deeply (
 171       [ split /\n/, $rt_sql ],
 172       [ split /\n/, $base_sql ],
 173       $msg,
 174     )
 175     : ok ($rt_sql eq $base_sql, $msg)
 176   ;
 177 }
 178
 179 sub _get_table_info {
 180   my @tables = @_;
 181
 182   my @info;
 183
 184   for my $t (@tables) {
 185     push @info, {
 186       name => $t->name,
 187       fields => [
 188         map { $_->name } ($t->get_fields),
 189       ],
 190     };
 191   }
 192
 193   return \@info;
 194 }
 195
 196 # takes an error string and an optional SQL block
 197 # returns the string conctenated with a line-numbered block for
 198 # easier reading
 199 sub _gen_diag {
 200   my ($err, $sql) = @_;
 201
 202   return 'Unknown error' unless $err;
 203
 204
 205   if ($sql and $ENV{SQLTTEST_RT_DEBUG}) {
 206     my @sql_lines;
 207     for (split /\n/, $sql) {
 208       push @sql_lines, sprintf ('%03d: %s',
 209         scalar @sql_lines + 1,
 210         $_,
 211       );
 212     }
 213
 214     return "$err\n\n" . join ("\n", @sql_lines);
 215   }
 216
 217   return $err;
 218 }