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 | |
f8a4f3b4 |
9 | sub filter { Test::More::pass( |
10 | 'Filter called with args: ' . join ', ', @_ |
11 | ) } |
44eb9098 |
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'; |
185c34d5 |
15 | |
185c34d5 |
16 | #============================================================================= |
44eb9098 |
17 | # SQL::Translator::Filter::HelloWorld - Test filter in a package |
da06ac74 |
18 | package # hide from cpan |
19 | SQL::Translator::Filter::HelloWorld; |
185c34d5 |
20 | |
21 | use strict; |
185c34d5 |
22 | |
23 | sub filter { |
44eb9098 |
24 | my ($schema,%args) = (shift,@_); |
185c34d5 |
25 | |
44eb9098 |
26 | my $greeting = $args{greeting} || "Hello"; |
27 | my $newtable = "${greeting}World"; |
28 | $schema->add_table( name => $newtable ); |
185c34d5 |
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 { |
3e1ed76b |
47 | maybe_plan(16, 'Template 2.20', 'Test::Differences', |
11ad2df9 |
48 | 'SQL::Translator::Parser::YAML', |
49 | 'SQL::Translator::Producer::YAML') |
50 | |
185c34d5 |
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 | |
495c5c2f |
66 | my $sqlt_version = $SQL::Translator::VERSION; |
e7a96c90 |
67 | my $ans_yaml = qq{--- |
185c34d5 |
68 | schema: |
69 | procedures: {} |
70 | tables: |
44eb9098 |
71 | GdayWorld: |
44eb9098 |
72 | constraints: [] |
73 | fields: {} |
74 | indices: [] |
75 | name: GdayWorld |
76 | options: [] |
77 | order: 3 |
185c34d5 |
78 | HelloWorld: |
185c34d5 |
79 | constraints: [] |
80 | fields: {} |
81 | indices: [] |
82 | name: HelloWorld |
83 | options: [] |
84 | order: 2 |
85 | PERSON: |
185c34d5 |
86 | constraints: [] |
87 | fields: |
88 | first_name: |
89 | data_type: foovar |
90 | default_value: ~ |
185c34d5 |
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 |
495c5c2f |
114 | version: $sqlt_version |
185c34d5 |
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 "); |
44eb9098 |
130 | is( $#_, 0, "Filter 1, got no args"); |
185c34d5 |
131 | }, |
132 | sub { |
133 | pass("Filter 2 called"); |
134 | isa_ok($_[0],"SQL::Translator::Schema", "Filter 2, arg0 "); |
44eb9098 |
135 | is( $#_, 0, "Filter 2, got no args"); |
185c34d5 |
136 | }, |
137 | |
138 | # Sub filter with args |
139 | [ sub { |
140 | pass("Filter 3 called"); |
141 | isa_ok($_[0],"SQL::Translator::Schema", "Filter 3, arg0 "); |
44eb9098 |
142 | is( $#_, 2, "Filter 3, go 2 args"); |
143 | is( $_[1], "hello", "Filter 3, arg1=hello"); |
144 | is( $_[2], "world", "Filter 3, arg2=world"); |
185c34d5 |
145 | }, |
44eb9098 |
146 | hello => "world" ], |
185c34d5 |
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::* |
44eb9098 |
165 | 'Ok', |
185c34d5 |
166 | [ 'HelloWorld' ], |
44eb9098 |
167 | [ 'HelloWorld', greeting => 'Gday' ], |
185c34d5 |
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"; |