Commit | Line | Data |
edc7ae17 |
1 | package SQL::Translator::Producer::JSON; |
2 | |
3 | =head1 NAME |
4 | |
5 | SQL::Translator::Producer::JSON - A JSON producer for SQL::Translator |
6 | |
7 | =head1 SYNOPSIS |
8 | |
9 | use SQL::Translator; |
10 | |
11 | my $translator = SQL::Translator->new(producer => 'JSON'); |
12 | |
13 | =head1 DESCRIPTION |
14 | |
15 | This module serializes a schema to a JSON string. |
16 | |
17 | =cut |
18 | |
19 | use strict; |
20 | use warnings; |
da93ce68 |
21 | our $VERSION = '1.60'; |
edc7ae17 |
22 | |
b39d4d3a |
23 | use JSON::MaybeXS 'to_json'; |
edc7ae17 |
24 | |
25 | sub produce { |
26 | my $translator = shift; |
27 | my $schema = $translator->schema; |
28 | |
29 | return to_json({ |
30 | schema => { |
31 | tables => { |
32 | map { ($_->name => view_table($_)) } |
33 | $schema->get_tables, |
34 | }, |
35 | views => { |
36 | map { ($_->name => view_view($_)) } |
37 | $schema->get_views, |
38 | }, |
39 | triggers => { |
40 | map { ($_->name => view_trigger($_)) } |
41 | $schema->get_triggers, |
42 | }, |
43 | procedures => { |
44 | map { ($_->name => view_procedure($_)) } |
45 | $schema->get_procedures, |
46 | }, |
47 | }, |
48 | translator => { |
49 | add_drop_table => $translator->add_drop_table, |
50 | filename => $translator->filename, |
51 | no_comments => $translator->no_comments, |
52 | parser_args => $translator->parser_args, |
53 | producer_args => $translator->producer_args, |
54 | parser_type => $translator->parser_type, |
55 | producer_type => $translator->producer_type, |
56 | show_warnings => $translator->show_warnings, |
57 | trace => $translator->trace, |
58 | version => $translator->version, |
59 | }, |
60 | keys %{$schema->extra} ? ('extra' => { $schema->extra } ) : (), |
61 | }, { |
62 | allow_blessed => 1, |
63 | allow_unknown => 1, |
64 | %{$translator->producer_args}, |
65 | }); |
66 | } |
67 | |
68 | sub view_table { |
69 | my $table = shift; |
70 | |
71 | return { |
72 | 'name' => $table->name, |
73 | 'order' => $table->order, |
74 | 'options' => $table->options || [], |
99fa843e |
75 | $table->comments ? ('comments' => [ $table->comments ] ) : (), |
edc7ae17 |
76 | 'constraints' => [ |
77 | map { view_constraint($_) } $table->get_constraints |
78 | ], |
79 | 'indices' => [ |
80 | map { view_index($_) } $table->get_indices |
81 | ], |
82 | 'fields' => { |
83 | map { ($_->name => view_field($_)) } |
84 | $table->get_fields |
85 | }, |
86 | keys %{$table->extra} ? ('extra' => { $table->extra } ) : (), |
87 | }; |
88 | } |
89 | |
90 | sub view_constraint { |
91 | my $constraint = shift; |
92 | |
93 | return { |
94 | 'deferrable' => scalar $constraint->deferrable, |
95 | 'expression' => scalar $constraint->expression, |
96 | 'fields' => [ map { ref $_ ? $_->name : $_ } $constraint->field_names ], |
97 | 'match_type' => scalar $constraint->match_type, |
98 | 'name' => scalar $constraint->name, |
99 | 'options' => scalar $constraint->options, |
100 | 'on_delete' => scalar $constraint->on_delete, |
101 | 'on_update' => scalar $constraint->on_update, |
102 | 'reference_fields' => [ map { ref $_ ? $_->name : $_ } $constraint->reference_fields ], |
103 | 'reference_table' => scalar $constraint->reference_table, |
104 | 'type' => scalar $constraint->type, |
105 | keys %{$constraint->extra} ? ('extra' => { $constraint->extra } ) : (), |
106 | }; |
107 | } |
108 | |
109 | sub view_field { |
110 | my $field = shift; |
111 | |
112 | return { |
113 | 'order' => scalar $field->order, |
114 | 'name' => scalar $field->name, |
115 | 'data_type' => scalar $field->data_type, |
116 | 'size' => [ $field->size ], |
117 | 'default_value' => scalar $field->default_value, |
118 | 'is_nullable' => scalar $field->is_nullable, |
119 | 'is_primary_key' => scalar $field->is_primary_key, |
120 | 'is_unique' => scalar $field->is_unique, |
121 | $field->is_auto_increment ? ('is_auto_increment' => 1) : (), |
99fa843e |
122 | $field->comments ? ('comments' => [ $field->comments ]) : (), |
edc7ae17 |
123 | keys %{$field->extra} ? ('extra' => { $field->extra } ) : (), |
124 | }; |
125 | } |
126 | |
127 | sub view_procedure { |
128 | my $procedure = shift; |
129 | |
130 | return { |
131 | 'order' => scalar $procedure->order, |
132 | 'name' => scalar $procedure->name, |
133 | 'sql' => scalar $procedure->sql, |
134 | 'parameters' => scalar $procedure->parameters, |
135 | 'owner' => scalar $procedure->owner, |
136 | 'comments' => scalar $procedure->comments, |
137 | keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (), |
138 | }; |
139 | } |
140 | |
141 | sub view_trigger { |
142 | my $trigger = shift; |
143 | |
144 | return { |
145 | 'order' => scalar $trigger->order, |
146 | 'name' => scalar $trigger->name, |
147 | 'perform_action_when' => scalar $trigger->perform_action_when, |
148 | 'database_events' => scalar $trigger->database_events, |
149 | 'fields' => scalar $trigger->fields, |
150 | 'on_table' => scalar $trigger->on_table, |
151 | 'action' => scalar $trigger->action, |
4384692a |
152 | (defined $trigger->scope ? ( |
153 | 'scope' => scalar $trigger->scope, |
154 | ) : ()), |
edc7ae17 |
155 | keys %{$trigger->extra} ? ('extra' => { $trigger->extra } ) : (), |
156 | }; |
157 | } |
158 | |
159 | sub view_view { |
160 | my $view = shift; |
161 | |
162 | return { |
163 | 'order' => scalar $view->order, |
164 | 'name' => scalar $view->name, |
165 | 'sql' => scalar $view->sql, |
166 | 'fields' => scalar $view->fields, |
167 | keys %{$view->extra} ? ('extra' => { $view->extra } ) : (), |
168 | }; |
169 | } |
170 | |
171 | sub view_index { |
172 | my $index = shift; |
173 | |
174 | return { |
175 | 'name' => scalar $index->name, |
176 | 'type' => scalar $index->type, |
177 | 'fields' => scalar $index->fields, |
178 | 'options' => scalar $index->options, |
179 | keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), |
180 | }; |
181 | } |
182 | |
183 | 1; |
184 | |
185 | =head1 SEE ALSO |
186 | |
b39d4d3a |
187 | SQL::Translator, JSON::MaybeXS, http://www.json.org/. |
edc7ae17 |
188 | |
189 | =head1 AUTHORS |
190 | |
191 | darren chamberlain E<lt>darren@cpan.orgE<gt>, |
192 | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>. |
193 | Jon Jensen E<lt>jonj@cpan.orgE<gt>. |
194 | |
195 | =cut |