Commit | Line | Data |
d3fad399 |
1 | package SQL::Translator::Parser::YAML; |
2 | |
3 | # ------------------------------------------------------------------- |
478f608d |
4 | # Copyright (C) 2002-2009 SQLFairy Authors |
d3fad399 |
5 | # |
6 | # This program is free software; you can redistribute it and/or |
7 | # modify it under the terms of the GNU General Public License as |
8 | # published by the Free Software Foundation; version 2. |
9 | # |
10 | # This program is distributed in the hope that it will be useful, but |
11 | # WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | # General Public License for more details. |
14 | # |
15 | # You should have received a copy of the GNU General Public License |
16 | # along with this program; if not, write to the Free Software |
17 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
18 | # 02111-1307 USA |
19 | # ------------------------------------------------------------------- |
20 | |
21 | use strict; |
da06ac74 |
22 | use vars qw($VERSION); |
11ad2df9 |
23 | $VERSION = '1.59'; |
d3fad399 |
24 | |
25 | use SQL::Translator::Schema; |
26 | use SQL::Translator::Utils qw(header_comment); |
6785b14e |
27 | use Data::Dumper; |
28 | use YAML qw(Load); |
d3fad399 |
29 | |
30 | sub parse { |
31 | my ($translator, $data) = @_; |
6785b14e |
32 | $data = Load($data); |
33 | $data = $data->{'schema'}; |
34 | |
f9aa1ac9 |
35 | warn "YAML data:",Dumper( $data ) if $translator->debug; |
6785b14e |
36 | |
d3fad399 |
37 | my $schema = $translator->schema; |
d3fad399 |
38 | |
6785b14e |
39 | # |
40 | # Tables |
41 | # |
42 | my @tables = |
43 | map { $data->{'tables'}{ $_->[1] } } |
44 | sort { $a->[0] <=> $b->[0] } |
7cc97e4f |
45 | map { [ $data->{'tables'}{ $_ }{'order'} || 0, $_ ] } |
6785b14e |
46 | keys %{ $data->{'tables'} } |
47 | ; |
48 | |
49 | for my $tdata ( @tables ) { |
4d438549 |
50 | |
6785b14e |
51 | my $table = $schema->add_table( |
4d438549 |
52 | map { |
53 | $tdata->{$_} ? ($_ => $tdata->{$_}) : () |
54 | } (qw/name extra options/) |
6785b14e |
55 | ) or die $schema->error; |
56 | |
57 | my @fields = |
58 | map { $tdata->{'fields'}{ $_->[1] } } |
59 | sort { $a->[0] <=> $b->[0] } |
60 | map { [ $tdata->{'fields'}{ $_ }{'order'}, $_ ] } |
61 | keys %{ $tdata->{'fields'} } |
62 | ; |
63 | |
64 | for my $fdata ( @fields ) { |
65 | $table->add_field( %$fdata ) or die $table->error; |
46a06350 |
66 | $table->primary_key( $fdata->{'name'} ) |
67 | if $fdata->{'is_primary_key'}; |
6785b14e |
68 | } |
623a0a9e |
69 | |
70 | for my $idata ( @{ $tdata->{'indices'} || [] } ) { |
71 | $table->add_index( %$idata ) or die $table->error; |
72 | } |
73 | |
74 | for my $cdata ( @{ $tdata->{'constraints'} || [] } ) { |
75 | $table->add_constraint( %$cdata ) or die $table->error; |
76 | } |
6785b14e |
77 | } |
78 | |
79 | # |
80 | # Views |
81 | # |
82 | my @views = |
83 | map { $data->{'views'}{ $_->[1] } } |
84 | sort { $a->[0] <=> $b->[0] } |
85 | map { [ $data->{'views'}{ $_ }{'order'}, $_ ] } |
86 | keys %{ $data->{'views'} } |
87 | ; |
88 | |
89 | for my $vdata ( @views ) { |
90 | $schema->add_view( %$vdata ) or die $schema->error; |
91 | } |
92 | |
93 | # |
94 | # Triggers |
95 | # |
96 | my @triggers = |
97 | map { $data->{'triggers'}{ $_->[1] } } |
98 | sort { $a->[0] <=> $b->[0] } |
99 | map { [ $data->{'triggers'}{ $_ }{'order'}, $_ ] } |
100 | keys %{ $data->{'triggers'} } |
101 | ; |
102 | |
103 | for my $tdata ( @triggers ) { |
104 | $schema->add_trigger( %$tdata ) or die $schema->error; |
105 | } |
106 | |
107 | # |
108 | # Procedures |
109 | # |
110 | my @procedures = |
111 | map { $data->{'procedures'}{ $_->[1] } } |
112 | sort { $a->[0] <=> $b->[0] } |
113 | map { [ $data->{'procedures'}{ $_ }{'order'}, $_ ] } |
114 | keys %{ $data->{'procedures'} } |
115 | ; |
116 | |
117 | for my $tdata ( @procedures ) { |
118 | $schema->add_procedure( %$tdata ) or die $schema->error; |
119 | } |
120 | |
01fe35e0 |
121 | if ( my $tr_data = $data->{'translator'} ) { |
122 | $translator->add_drop_table( $tr_data->{'add_drop_table'} ); |
123 | $translator->filename( $tr_data->{'filename'} ); |
124 | $translator->no_comments( $tr_data->{'no_comments'} ); |
125 | $translator->parser_args( $tr_data->{'parser_args'} ); |
126 | $translator->producer_args( $tr_data->{'producer_args'} ); |
127 | $translator->parser_type( $tr_data->{'parser_type'} ); |
128 | $translator->producer_type( $tr_data->{'producer_type'} ); |
129 | $translator->show_warnings( $tr_data->{'show_warnings'} ); |
130 | $translator->trace( $tr_data->{'trace'} ); |
131 | } |
132 | |
6785b14e |
133 | return 1; |
d3fad399 |
134 | } |
135 | |
136 | 1; |
137 | |
138 | __END__ |
139 | |
140 | =head1 NAME |
141 | |
142 | SQL::Translator::Parser::YAML - Parse a YAML representation of a schema |
143 | |
144 | =head1 SYNOPSIS |
145 | |
146 | use SQL::Translator; |
147 | |
148 | my $translator = SQL::Translator->new(parser => "YAML"); |
149 | |
150 | =head1 DESCRIPTION |
151 | |
152 | C<SQL::Translator::Parser::YAML> parses a schema serialized with YAML. |
153 | |
90075866 |
154 | =head1 AUTHORS |
d3fad399 |
155 | |
6785b14e |
156 | Darren Chamberlain E<lt>darren@cpan.orgE<gt>, |
11ad2df9 |
157 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt>. |