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           is_nullable: 1
  87           is_primary_key: 0
  88           is_unique: 0
  89           name: first_name
  90           order: 1
  91           size:
  92             - 0
  93       indices: []
  94       name: PERSON
  95       options: []
  96       order: 1
  97   triggers: {}
  98   views: {}
  99 translator:
 100   add_drop_table: 0
 101   filename: ~
 102   no_comments: 0
 103   parser_args: {}
 104   parser_type: SQL::Translator::Parser::YAML
 105   producer_args: {}
 106   producer_type: SQL::Translator::Producer::YAML
 107   show_warnings: 1
 108   trace: 0
 109   version: $sqlt_version
 110 };
 111
 112 # Parse the test XML schema
 113 my $obj;
 114 $obj = SQL::Translator->new(
 115     debug          => 0,
 116     show_warnings  => 1,
 117     parser         => "YAML",
 118     data           => $in_yaml,
 119     to             => "YAML",
 120     filters => [
 121         # Check they get called ok
 122         sub {
 123             pass("Filter 1 called");
 124             isa_ok($_[0],"SQL::Translator::Schema", "Filter 1, arg0 ");
 125             is( $#_, 0, "Filter 1, got no args");
 126         },
 127         sub {
 128             pass("Filter 2 called");
 129             isa_ok($_[0],"SQL::Translator::Schema", "Filter 2, arg0 ");
 130             is( $#_, 0, "Filter 2, got no args");
 131         },
 132
 133         # Sub filter with args
 134         [ sub {
 135             pass("Filter 3 called");
 136             isa_ok($_[0],"SQL::Translator::Schema", "Filter 3, arg0 ");
 137             is( $#_, 2, "Filter 3, go 2 args");
 138             is( $_[1], "hello", "Filter 3, arg1=hello");
 139             is( $_[2], "world", "Filter 3, arg2=world");
 140         },
 141         hello => "world" ],
 142
 143         # Uppercase all the table names.
 144         sub {
 145             my $schema = shift;
 146             foreach ($schema->get_tables) {
 147                 $_->name(uc $_->name);
 148             }
 149         },
 150
 151         # lowercase all the field names.
 152         sub {
 153             my $schema = shift;
 154             foreach ( map { $_->get_fields } $schema->get_tables ) {
 155                 $_->name(lc $_->name);
 156             }
 157         },
 158
 159         # Filter from SQL::Translator::Filter::*
 160         'Ok',
 161         [ 'HelloWorld' ],
 162         [ 'HelloWorld', greeting => 'Gday' ],
 163     ],
 164
 165 ) or die "Failed to create translator object: ".SQL::Translator->error;
 166
 167 my $out;
 168 lives_ok { $out = $obj->translate; }  "Translate ran";
 169 is $obj->error, ''                   ,"No errors";
 170 ok $out ne ""                        ,"Produced something!";
 171 eq_or_diff $out, $ans_yaml           ,"Output looks right";