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