Fleshing out.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / YAML.pm
1 package SQL::Translator::Parser::YAML;
2
3 # -------------------------------------------------------------------
4 # $Id: YAML.pm,v 1.2 2003-10-08 22:44:52 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 darren chamberlain <darren@cpan.org>,
7 #   Ken Y. Clark <kclark@cpan.org>.
8 #
9 # This program is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License as
11 # published by the Free Software Foundation; version 2.
12 #
13 # This program is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 # General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # 02111-1307  USA
22 # -------------------------------------------------------------------
23
24 use strict;
25 use vars qw($VERSION);
26 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
27
28 use SQL::Translator::Schema;
29 use SQL::Translator::Utils qw(header_comment);
30 use Data::Dumper;
31 use YAML qw(Load);
32
33 sub parse {
34     my ($translator, $data) = @_;
35     $data = Load($data);
36     $data = $data->{'schema'};
37
38     warn Dumper( $data ) if $translator->debug;
39
40     my $schema = $translator->schema;
41
42     #
43     # Tables
44     #
45     my @tables = 
46         map   { $data->{'tables'}{ $_->[1] } }
47         sort  { $a->[0] <=> $b->[0] }
48         map   { [ $data->{'tables'}{ $_ }{'order'}, $_ ] }
49         keys %{ $data->{'tables'} }
50     ;
51
52     for my $tdata ( @tables ) {
53         my $table = $schema->add_table(
54             name  => $tdata->{'name'},
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;
66         }
67     }
68
69     #
70     # Views
71     #
72     my @views = 
73         map   { $data->{'views'}{ $_->[1] } }
74         sort  { $a->[0] <=> $b->[0] }
75         map   { [ $data->{'views'}{ $_ }{'order'}, $_ ] }
76         keys %{ $data->{'views'} }
77     ;
78
79     for my $vdata ( @views ) {
80         $schema->add_view( %$vdata ) or die $schema->error;
81     }
82
83     #
84     # Triggers
85     #
86     my @triggers = 
87         map   { $data->{'triggers'}{ $_->[1] } }
88         sort  { $a->[0] <=> $b->[0] }
89         map   { [ $data->{'triggers'}{ $_ }{'order'}, $_ ] }
90         keys %{ $data->{'triggers'} }
91     ;
92
93     for my $tdata ( @triggers ) {
94         $schema->add_trigger( %$tdata ) or die $schema->error;
95     }
96
97     #
98     # Procedures
99     #
100     my @procedures = 
101         map   { $data->{'procedures'}{ $_->[1] } }
102         sort  { $a->[0] <=> $b->[0] }
103         map   { [ $data->{'procedures'}{ $_ }{'order'}, $_ ] }
104         keys %{ $data->{'procedures'} }
105     ;
106
107     for my $tdata ( @procedures ) {
108         $schema->add_procedure( %$tdata ) or die $schema->error;
109     }
110
111     return 1;
112 }
113
114 1;
115
116 __END__
117
118 =head1 NAME
119
120 SQL::Translator::Parser::YAML - Parse a YAML representation of a schema
121
122 =head1 SYNOPSIS
123
124     use SQL::Translator;
125
126     my $translator = SQL::Translator->new(parser => "YAML");
127
128 =head1 DESCRIPTION
129
130 C<SQL::Translator::Parser::YAML> parses a schema serialized with YAML.
131
132 =head1 AUTHOR
133
134 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
135 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.