lib/SQL/Translator/Parser/YAML.pm

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