X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FYAML.pm;h=5b3091181f75e7cc029eca6e62dcdfd8399369b1;hb=da06ac74ada30aacf656943306679a28605ad5c8;hp=12a08c56fd0d1cf7d1c599a8eb0da766fad479b4;hpb=d3fad3998a3f824c3eb36b14d373bc71c9c4b3d1;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index 12a08c5..5b30911 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -1,9 +1,9 @@ package SQL::Translator::Producer::YAML; # ------------------------------------------------------------------- -# $Id: YAML.pm,v 1.1 2003-10-08 16:33:13 dlc Exp $ +# $Id: YAML.pm 1440 2009-01-17 16:31:57Z jawnsy $ # ------------------------------------------------------------------- -# Copyright (C) 2003 darren chamberlain , +# Copyright (C) 2002-2009 SQLFairy Authors # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -20,58 +20,194 @@ package SQL::Translator::Producer::YAML; # 02111-1307 USA # ------------------------------------------------------------------- +=head1 NAME + +SQL::Translator::Producer::YAML - A YAML producer for SQL::Translator + +=head1 SYNOPSIS + + use SQL::Translator; + + my $translator = SQL::Translator->new(producer => 'YAML'); + +=head1 DESCRIPTION + +This module uses YAML to serialize a schema to a string so that it +can be saved to disk. Serializing a schema and then calling producers +on the stored can realize significant performance gains when parsing +takes a long time. + +=cut + use strict; use vars qw($VERSION); -$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.99'; -use SQL::Translator::Utils qw(header_comment); +use YAML qw(Dump); +# ------------------------------------------------------------------- sub produce { - my $translator = shift; - my $schema = $translator->schema; - - return - join "\n" => - '--- #YAML:1.0', - #header_comment('', '# '), - map { view_table($_) } $schema->get_tables; + my $translator = shift; + my $schema = $translator->schema; + + return Dump({ + schema => { + 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, + }, + }, + translator => { + add_drop_table => $translator->add_drop_table, + filename => $translator->filename, + no_comments => $translator->no_comments, + parser_args => $translator->parser_args, + producer_args => $translator->producer_args, + parser_type => $translator->parser_type, + producer_type => $translator->producer_type, + show_warnings => $translator->show_warnings, + trace => $translator->trace, + version => $translator->version, + } + }); } +# ------------------------------------------------------------------- sub view_table { my $table = shift; - return - sprintf "%s:\n%s\n", - $table->name, - join "\n" => - map { " $_" } - map { view_field($_) } $table->get_fields; + return { + 'name' => $table->name, + 'order' => $table->order, + 'options' => $table->options || [], + $table->comments ? ('comments' => $table->comments ) : (), + 'constraints' => [ + map { view_constraint($_) } $table->get_constraints + ], + 'indices' => [ + map { view_index($_) } $table->get_indices + ], + 'fields' => { + map { ($_->name => view_field($_)) } + $table->get_fields + }, + }; } +# ------------------------------------------------------------------- +sub view_constraint { + my $constraint = shift; + + return { + 'deferrable' => scalar $constraint->deferrable, + 'expression' => scalar $constraint->expression, + 'fields' => [ map { ref $_ ? $_->name : $_ } $constraint->field_names ], + 'match_type' => scalar $constraint->match_type, + 'name' => scalar $constraint->name, + 'options' => scalar $constraint->options, + 'on_delete' => scalar $constraint->on_delete, + 'on_update' => scalar $constraint->on_update, + 'reference_fields' => scalar $constraint->reference_fields, + 'reference_table' => scalar $constraint->reference_table, + 'type' => scalar $constraint->type, + }; +} + +# ------------------------------------------------------------------- sub view_field { my $field = shift; - return - sprintf("%s: %s" => $field->name), - map { - sprintf " %s: %s" => $_->[0], view($_->[1]) - } ( - [ 'order' => $field->order ], - [ 'name' => $field->name ], - [ 'type' => $field->data_type ], - [ 'size' => [ $field->size ] ], - [ 'extra' => { $field->extra } ], - ); + return { + 'order' => scalar $field->order, + 'name' => scalar $field->name, + 'data_type' => scalar $field->data_type, + 'size' => [ $field->size ], + 'default_value' => scalar $field->default_value, + 'is_nullable' => scalar $field->is_nullable, + 'is_primary_key' => scalar $field->is_primary_key, + 'is_unique' => scalar $field->is_unique, + $field->is_auto_increment ? ('is_auto_increment' => 1) : (), + $field->comments ? ('comments' => $field->comments) : (), + 'extra' => { $field->extra }, + }; +} + +# ------------------------------------------------------------------- +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, + }; } -sub view { - my $thingie = shift; +# ------------------------------------------------------------------- +sub view_index { + my $index = shift; - { '' => sub { $_[0] }, - 'SCALAR' => sub { ${$_[0]} }, - 'ARRAY' => sub { join "\n - $_", @{$_[0]} }, - 'HASH' => sub { join "\n " => map { "$_: $_[0]->{$_}" } keys %{$_[0]} }, - }->{ref $thingie}->($thingie); + return { + 'name' => scalar $index->name, + 'type' => scalar $index->type, + 'fields' => scalar $index->fields, + 'options' => scalar $index->options, + }; } 1; + +# ------------------------------------------------------------------- + +=head1 SEE ALSO + +SQL::Translator, YAML, http://www.yaml.org/. + +=head1 AUTHORS + +darren chamberlain Edarren@cpan.orgE, +Ken Y. Clark Ekclark@cpan.orgE. + +=cut