Commit | Line | Data |
185c34d5 |
1 | #!/usr/bin/perl -w |
2 | # vim:filetype=perl |
3 | |
44eb9098 |
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'; |
185c34d5 |
13 | |
185c34d5 |
14 | #============================================================================= |
44eb9098 |
15 | # SQL::Translator::Filter::HelloWorld - Test filter in a package |
185c34d5 |
16 | package SQL::Translator::Filter::HelloWorld; |
17 | |
18 | use strict; |
19 | use vars qw/$VERSION/; |
20 | $VERSION=0.1; |
21 | |
22 | sub filter { |
44eb9098 |
23 | my ($schema,%args) = (shift,@_); |
185c34d5 |
24 | |
44eb9098 |
25 | my $greeting = $args{greeting} || "Hello"; |
26 | my $newtable = "${greeting}World"; |
27 | $schema->add_table( name => $newtable ); |
185c34d5 |
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 { |
44eb9098 |
46 | maybe_plan(16, 'Template', 'Test::Differences') |
185c34d5 |
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 | |
495c5c2f |
62 | my $sqlt_version = $SQL::Translator::VERSION; |
e7a96c90 |
63 | my $ans_yaml = qq{--- |
185c34d5 |
64 | schema: |
65 | procedures: {} |
66 | tables: |
44eb9098 |
67 | GdayWorld: |
44eb9098 |
68 | constraints: [] |
69 | fields: {} |
70 | indices: [] |
71 | name: GdayWorld |
72 | options: [] |
73 | order: 3 |
185c34d5 |
74 | HelloWorld: |
185c34d5 |
75 | constraints: [] |
76 | fields: {} |
77 | indices: [] |
78 | name: HelloWorld |
79 | options: [] |
80 | order: 2 |
81 | PERSON: |
185c34d5 |
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 |
495c5c2f |
111 | version: $sqlt_version |
185c34d5 |
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 "); |
44eb9098 |
127 | is( $#_, 0, "Filter 1, got no args"); |
185c34d5 |
128 | }, |
129 | sub { |
130 | pass("Filter 2 called"); |
131 | isa_ok($_[0],"SQL::Translator::Schema", "Filter 2, arg0 "); |
44eb9098 |
132 | is( $#_, 0, "Filter 2, got no args"); |
185c34d5 |
133 | }, |
134 | |
135 | # Sub filter with args |
136 | [ sub { |
137 | pass("Filter 3 called"); |
138 | isa_ok($_[0],"SQL::Translator::Schema", "Filter 3, arg0 "); |
44eb9098 |
139 | is( $#_, 2, "Filter 3, go 2 args"); |
140 | is( $_[1], "hello", "Filter 3, arg1=hello"); |
141 | is( $_[2], "world", "Filter 3, arg2=world"); |
185c34d5 |
142 | }, |
44eb9098 |
143 | hello => "world" ], |
185c34d5 |
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::* |
44eb9098 |
162 | 'Ok', |
185c34d5 |
163 | [ 'HelloWorld' ], |
44eb9098 |
164 | [ 'HelloWorld', greeting => 'Gday' ], |
185c34d5 |
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"; |