t/36-filters.t

   1 #!/usr/bin/perl -w
   2 # vim:filetype=perl
   3
   4 #=============================================================================
   5 # Test Package based filters that oks when called.
   6 package SQL::Translator::Filter::Ok;
   7 use strict;
   8
   9 sub filter { Test::More::pass(@_) }
  10
  11 # Hack to allow sqlt to see our module as it wasn't loaded from a .pm
  12 $INC{'SQL/Translator/Filter/Ok.pm'} = 'lib/SQL/Translator/Filter/Ok.pm';
  13
  14 #=============================================================================
  15 # SQL::Translator::Filter::HelloWorld - Test filter in a package
  16 package   # hide from cpan
  17     SQL::Translator::Filter::HelloWorld;
  18
  19 use strict;
  20
  21 sub filter {
  22     my ($schema,%args) = (shift,@_);
  23
  24     my $greeting = $args{greeting} || "Hello";
  25     my $newtable = "${greeting}World";
  26     $schema->add_table( name => $newtable );
  27 }
  28
  29 # Hack to allow sqlt to see our module as it wasn't loaded from a .pm
  30 $INC{'SQL/Translator/Filter/HelloWorld.pm'}
  31     = 'lib/SQL/Translator/Filter/HelloWorld.pm';
  32
  33 #=============================================================================
  34
  35 package main;
  36
  37 use strict;
  38 use Test::More;
  39 use Test::Exception;
  40 use Test::SQL::Translator qw(maybe_plan);
  41
  42 use Data::Dumper;
  43
  44 BEGIN {
  45     maybe_plan(16, 'Template', 'Test::Differences')
  46 }
  47 use Test::Differences;
  48 use SQL::Translator;
  49
  50 my $in_yaml = qq{--- #YAML:1.0
  51 schema:
  52   tables:
  53     person:
  54       name: person
  55       fields:
  56         first_name:
  57           data_type: foovar
  58           name: First_Name
  59 };
  60
  61 my $sqlt_version = $SQL::Translator::VERSION;
  62 my $ans_yaml = qq{---
  63 schema:
  64   procedures: {}
  65   tables:
  66     GdayWorld:
  67       constraints: []
  68       fields: {}
  69       indices: []
  70       name: GdayWorld
  71       options: []
  72       order: 3
  73     HelloWorld:
  74       constraints: []
  75       fields: {}
  76       indices: []
  77       name: HelloWorld
  78       options: []
  79       order: 2
  80     PERSON:
  81       constraints: []
  82       fields:
  83         first_name:
  84           data_type: foovar
  85           default_value: ~
  86           extra: {}
  87           is_nullable: 1
  88           is_primary_key: 0
  89           is_unique: 0
  90           name: first_name
  91           order: 1
  92           size:
  93             - 0
  94       indices: []
  95       name: PERSON
  96       options: []
  97       order: 1
  98   triggers: {}
  99   views: {}
 100 translator:
 101   add_drop_table: 0
 102   filename: ~
 103   no_comments: 0
 104   parser_args: {}
 105   parser_type: SQL::Translator::Parser::YAML
 106   producer_args: {}
 107   producer_type: SQL::Translator::Producer::YAML
 108   show_warnings: 1
 109   trace: 0
 110   version: $sqlt_version
 111 };
 112
 113 # Parse the test XML schema
 114 my $obj;
 115 $obj = SQL::Translator->new(
 116     debug          => 0,
 117     show_warnings  => 1,
 118     parser         => "YAML",
 119     data           => $in_yaml,
 120     to             => "YAML",
 121     filters => [
 122         # Check they get called ok
 123         sub {
 124             pass("Filter 1 called");
 125             isa_ok($_[0],"SQL::Translator::Schema", "Filter 1, arg0 ");
 126             is( $#_, 0, "Filter 1, got no args");
 127         },
 128         sub {
 129             pass("Filter 2 called");
 130             isa_ok($_[0],"SQL::Translator::Schema", "Filter 2, arg0 ");
 131             is( $#_, 0, "Filter 2, got no args");
 132         },
 133
 134         # Sub filter with args
 135         [ sub {
 136             pass("Filter 3 called");
 137             isa_ok($_[0],"SQL::Translator::Schema", "Filter 3, arg0 ");
 138             is( $#_, 2, "Filter 3, go 2 args");
 139             is( $_[1], "hello", "Filter 3, arg1=hello");
 140             is( $_[2], "world", "Filter 3, arg2=world");
 141         },
 142         hello => "world" ],
 143
 144         # Uppercase all the table names.
 145         sub {
 146             my $schema = shift;
 147             foreach ($schema->get_tables) {
 148                 $_->name(uc $_->name);
 149             }
 150         },
 151
 152         # lowercase all the field names.
 153         sub {
 154             my $schema = shift;
 155             foreach ( map { $_->get_fields } $schema->get_tables ) {
 156                 $_->name(lc $_->name);
 157             }
 158         },
 159
 160         # Filter from SQL::Translator::Filter::*
 161         'Ok',
 162         [ 'HelloWorld' ],
 163         [ 'HelloWorld', greeting => 'Gday' ],
 164     ],
 165
 166 ) or die "Failed to create translator object: ".SQL::Translator->error;
 167
 168 my $out;
 169 lives_ok { $out = $obj->translate; }  "Translate ran";
 170 is $obj->error, ''                   ,"No errors";
 171 ok $out ne ""                        ,"Produced something!";
 172 eq_or_diff $out, $ans_yaml           ,"Output looks right";