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