From: Ken Youens-Clark Date: Wed, 8 Oct 2003 22:46:17 +0000 (+0000) Subject: Fleshing out. X-Git-Tag: v0.04~99 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6785b14ef3cd6f319abd7c9ec2633a04334f0a4a;p=dbsrgits%2FSQL-Translator.git Fleshing out. --- diff --git a/lib/SQL/Translator/Parser/YAML.pm b/lib/SQL/Translator/Parser/YAML.pm index fe996cb..f00b8d3 100644 --- a/lib/SQL/Translator/Parser/YAML.pm +++ b/lib/SQL/Translator/Parser/YAML.pm @@ -1,9 +1,10 @@ package SQL::Translator::Parser::YAML; # ------------------------------------------------------------------- -# $Id: YAML.pm,v 1.1 2003-10-08 16:33:13 dlc Exp $ +# $Id: YAML.pm,v 1.2 2003-10-08 22:44:52 kycl4rk Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 darren chamberlain , +# Ken Y. Clark . # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -22,17 +23,92 @@ package SQL::Translator::Parser::YAML; use strict; use vars qw($VERSION); -$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; use SQL::Translator::Schema; use SQL::Translator::Utils qw(header_comment); -use YAML; +use Data::Dumper; +use YAML qw(Load); sub parse { my ($translator, $data) = @_; + $data = Load($data); + $data = $data->{'schema'}; + + warn Dumper( $data ) if $translator->debug; + my $schema = $translator->schema; - my $data = Load($data); + # + # Tables + # + my @tables = + map { $data->{'tables'}{ $_->[1] } } + sort { $a->[0] <=> $b->[0] } + map { [ $data->{'tables'}{ $_ }{'order'}, $_ ] } + keys %{ $data->{'tables'} } + ; + + for my $tdata ( @tables ) { + my $table = $schema->add_table( + name => $tdata->{'name'}, + ) or die $schema->error; + + my @fields = + map { $tdata->{'fields'}{ $_->[1] } } + sort { $a->[0] <=> $b->[0] } + map { [ $tdata->{'fields'}{ $_ }{'order'}, $_ ] } + keys %{ $tdata->{'fields'} } + ; + + for my $fdata ( @fields ) { + $table->add_field( %$fdata ) or die $table->error; + } + } + + # + # Views + # + my @views = + map { $data->{'views'}{ $_->[1] } } + sort { $a->[0] <=> $b->[0] } + map { [ $data->{'views'}{ $_ }{'order'}, $_ ] } + keys %{ $data->{'views'} } + ; + + for my $vdata ( @views ) { + $schema->add_view( %$vdata ) or die $schema->error; + } + + # + # Triggers + # + my @triggers = + map { $data->{'triggers'}{ $_->[1] } } + sort { $a->[0] <=> $b->[0] } + map { [ $data->{'triggers'}{ $_ }{'order'}, $_ ] } + keys %{ $data->{'triggers'} } + ; + + for my $tdata ( @triggers ) { + $schema->add_trigger( %$tdata ) or die $schema->error; + } + + # + # Procedures + # + my @procedures = + map { $data->{'procedures'}{ $_->[1] } } + sort { $a->[0] <=> $b->[0] } + map { [ $data->{'procedures'}{ $_ }{'order'}, $_ ] } + keys %{ $data->{'procedures'} } + ; + + for my $tdata ( @procedures ) { + $schema->add_procedure( %$tdata ) or die $schema->error; + } + + return 1; } 1; @@ -55,4 +131,5 @@ C parses a schema serialized with YAML. =head1 AUTHOR -Darren Chamberlain Edarren@cpan.orgE +Darren Chamberlain Edarren@cpan.orgE, +Ken Y. Clark Ekclark@cpan.orgE. diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index bfaa7ed..7c54273 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -1,9 +1,10 @@ package SQL::Translator::Producer::YAML; # ------------------------------------------------------------------- -# $Id: YAML.pm,v 1.2 2003-10-08 17:27:40 dlc Exp $ +# $Id: YAML.pm,v 1.3 2003-10-08 22:46:17 kycl4rk Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 darren chamberlain , +# Ken Y. Clark . # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -22,30 +23,51 @@ package SQL::Translator::Producer::YAML; use strict; use vars qw($VERSION); -$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; use YAML qw(Dump); +# ------------------------------------------------------------------- sub produce { my $translator = shift; my $schema = $translator->schema; return Dump({ schema => { - map { ($_->name => view_table($_)) } $schema->get_tables + tables => { + map { ($_->name => view_table($_)) } $schema->get_tables, + }, + views => { + map { ($_->name => view_view($_)) } $schema->get_views, + }, + triggers => { + map { ($_->name => view_trigger($_)) } $schema->get_triggers, + }, + procedures => { + map { ($_->name => view_procedure($_)) } + $schema->get_procedures, + }, } }); } +# ------------------------------------------------------------------- sub view_table { my $table = shift; my $name = $table->name; return { - map { ($_->name => view_field($_)) } $table->get_fields + 'name' => $table->name, + 'order' => $table->order, + 'options' => $table->options || [], + 'comments' => $table->comments || '', + 'fields' => { + map { ($_->name => view_field($_)) } $table->get_fields + }, }; } +# ------------------------------------------------------------------- sub view_field { my $field = shift; @@ -58,8 +80,56 @@ sub view_field { }; } +# ------------------------------------------------------------------- +sub view_procedure { + my $procedure = shift; + + return { + 'order' => scalar $procedure->order, + 'name' => scalar $procedure->name, + 'sql' => scalar $procedure->sql, + 'parameters' => scalar $procedure->parameters, + 'owner' => scalar $procedure->owner, + 'comments' => scalar $procedure->comments, + }; +} + +# ------------------------------------------------------------------- +sub view_trigger { + my $trigger = shift; + + return { + 'order' => scalar $trigger->order, + 'name' => scalar $trigger->name, + 'perform_action_when' => scalar $trigger->perform_action_when, + 'database_event' => scalar $trigger->database_event, + 'fields' => scalar $trigger->fields, + 'on_table' => scalar $trigger->on_table, + 'action' => scalar $trigger->action, + }; +} + +# ------------------------------------------------------------------- +sub view_view { + my $view = shift; + + return { + 'order' => scalar $view->order, + 'name' => scalar $view->name, + 'sql' => scalar $view->sql, + 'fields' => scalar $view->fields, + }; +} + 1; =head1 NAME SQL::Translator::Producer::YAML - A YAML producer for SQL::Translator + +=head1 AUTHORS + +darren chamberlain Edarren@cpan.orgE, +Ken Y. Clark Ekclark@cpan.orgE. + +=cut