t/36-filters.t

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