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