t/60roundtrip.t

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