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