lib/SQL/Translator/Parser/YAML.pm

   1 package SQL::Translator::Parser::YAML;
   2
   3 # -------------------------------------------------------------------
   4 # $Id$
   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$ =~ /(\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 "YAML data:",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'} || 0, $_ ] }
  48         keys %{ $data->{'tables'} }
  49     ;
  50
  51     for my $tdata ( @tables ) {
  52
  53         my $table = $schema->add_table(
  54             map {
  55               $tdata->{$_} ? ($_ => $tdata->{$_}) : ()
  56             } (qw/name extra options/)
  57         ) or die $schema->error;
  58
  59         my @fields =
  60             map   { $tdata->{'fields'}{ $_->[1] } }
  61             sort  { $a->[0] <=> $b->[0] }
  62             map   { [ $tdata->{'fields'}{ $_ }{'order'}, $_ ] }
  63             keys %{ $tdata->{'fields'} }
  64         ;
  65
  66         for my $fdata ( @fields ) {
  67             $table->add_field( %$fdata ) or die $table->error;
  68             $table->primary_key( $fdata->{'name'} )
  69                 if $fdata->{'is_primary_key'};
  70         }
  71
  72         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
  73             $table->add_index( %$idata ) or die $table->error;
  74         }
  75
  76         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
  77             $table->add_constraint( %$cdata ) or die $table->error;
  78         }
  79     }
  80
  81     #
  82     # Views
  83     #
  84     my @views =
  85         map   { $data->{'views'}{ $_->[1] } }
  86         sort  { $a->[0] <=> $b->[0] }
  87         map   { [ $data->{'views'}{ $_ }{'order'}, $_ ] }
  88         keys %{ $data->{'views'} }
  89     ;
  90
  91     for my $vdata ( @views ) {
  92         $schema->add_view( %$vdata ) or die $schema->error;
  93     }
  94
  95     #
  96     # Triggers
  97     #
  98     my @triggers =
  99         map   { $data->{'triggers'}{ $_->[1] } }
 100         sort  { $a->[0] <=> $b->[0] }
 101         map   { [ $data->{'triggers'}{ $_ }{'order'}, $_ ] }
 102         keys %{ $data->{'triggers'} }
 103     ;
 104
 105     for my $tdata ( @triggers ) {
 106         $schema->add_trigger( %$tdata ) or die $schema->error;
 107     }
 108
 109     #
 110     # Procedures
 111     #
 112     my @procedures =
 113         map   { $data->{'procedures'}{ $_->[1] } }
 114         sort  { $a->[0] <=> $b->[0] }
 115         map   { [ $data->{'procedures'}{ $_ }{'order'}, $_ ] }
 116         keys %{ $data->{'procedures'} }
 117     ;
 118
 119     for my $tdata ( @procedures ) {
 120         $schema->add_procedure( %$tdata ) or die $schema->error;
 121     }
 122
 123     if ( my $tr_data = $data->{'translator'} ) {
 124         $translator->add_drop_table( $tr_data->{'add_drop_table'} );
 125         $translator->filename( $tr_data->{'filename'} );
 126         $translator->no_comments( $tr_data->{'no_comments'} );
 127         $translator->parser_args( $tr_data->{'parser_args'} );
 128         $translator->producer_args( $tr_data->{'producer_args'} );
 129         $translator->parser_type( $tr_data->{'parser_type'} );
 130         $translator->producer_type( $tr_data->{'producer_type'} );
 131         $translator->show_warnings( $tr_data->{'show_warnings'} );
 132         $translator->trace( $tr_data->{'trace'} );
 133     }
 134
 135     return 1;
 136 }
 137
 138 1;
 139
 140 __END__
 141
 142 =head1 NAME
 143
 144 SQL::Translator::Parser::YAML - Parse a YAML representation of a schema
 145
 146 =head1 SYNOPSIS
 147
 148     use SQL::Translator;
 149
 150     my $translator = SQL::Translator->new(parser => "YAML");
 151
 152 =head1 DESCRIPTION
 153
 154 C<SQL::Translator::Parser::YAML> parses a schema serialized with YAML.
 155
 156 =head1 AUTHORS
 157
 158 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
 159 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.