X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FYAML.pm;h=31b242086d110b5cd0a58639549d255487054102;hb=ba506e52c480afe33dfec6b38a12759fad1e7fa2;hp=0f755311076c19c96c7754c6e1235278855c3d20;hpb=75c75c55c6f51425c9b3667396d60ce32e0d341a;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index 0f75531..31b2420 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -1,10 +1,7 @@ package SQL::Translator::Producer::YAML; # ------------------------------------------------------------------- -# $Id: YAML.pm,v 1.5 2003-10-15 19:19:13 kycl4rk Exp $ -# ------------------------------------------------------------------- -# Copyright (C) 2003 darren chamberlain , -# Ken Y. Clark . +# 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 @@ -29,8 +26,7 @@ SQL::Translator::Producer::YAML - A YAML producer for SQL::Translator use SQL::Translator; - my $translator = SQL::Translator->new; - $translator->producer('YAML'); + my $translator = SQL::Translator->new(producer => 'YAML'); =head1 DESCRIPTION @@ -43,47 +39,90 @@ takes a long time. use strict; use vars qw($VERSION); -$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.60'; use YAML qw(Dump); # ------------------------------------------------------------------- sub produce { - my $translator = shift; - my $schema = $translator->schema; + my $translator = shift; + my $schema = $translator->schema; return Dump({ schema => { tables => { - map { ($_->name => view_table($_)) } $schema->get_tables, + map { ($_->name => view_table($_)) } + $schema->get_tables, }, views => { - map { ($_->name => view_view($_)) } $schema->get_views, + map { ($_->name => view_view($_)) } + $schema->get_views, }, triggers => { - map { ($_->name => view_trigger($_)) } $schema->get_triggers, + map { ($_->name => view_trigger($_)) } + $schema->get_triggers, }, procedures => { map { ($_->name => view_procedure($_)) } - $schema->get_procedures, + $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, + }, + keys %{$schema->extra} ? ('extra' => { $schema->extra } ) : (), }); } # ------------------------------------------------------------------- sub view_table { my $table = shift; - my $name = $table->name; return { - 'name' => $table->name, - 'order' => $table->order, - 'options' => $table->options || [], - 'comments' => $table->comments || '', - 'fields' => { - map { ($_->name => view_field($_)) } $table->get_fields + '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 }, + keys %{$table->extra} ? ('extra' => { $table->extra } ) : (), + }; +} + +# ------------------------------------------------------------------- +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' => [ map { ref $_ ? $_->name : $_ } $constraint->reference_fields ], + 'reference_table' => scalar $constraint->reference_table, + 'type' => scalar $constraint->type, + keys %{$constraint->extra} ? ('extra' => { $constraint->extra } ) : (), }; } @@ -92,15 +131,17 @@ sub view_field { my $field = shift; 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, - 'extra' => { $field->extra }, + '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) : (), + keys %{$field->extra} ? ('extra' => { $field->extra } ) : (), }; } @@ -115,6 +156,7 @@ sub view_procedure { 'parameters' => scalar $procedure->parameters, 'owner' => scalar $procedure->owner, 'comments' => scalar $procedure->comments, + keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (), }; } @@ -126,10 +168,11 @@ sub view_trigger { 'order' => scalar $trigger->order, 'name' => scalar $trigger->name, 'perform_action_when' => scalar $trigger->perform_action_when, - 'database_event' => scalar $trigger->database_event, + 'database_events' => scalar $trigger->database_events, 'fields' => scalar $trigger->fields, 'on_table' => scalar $trigger->on_table, 'action' => scalar $trigger->action, + keys %{$trigger->extra} ? ('extra' => { $trigger->extra } ) : (), }; } @@ -142,6 +185,20 @@ sub view_view { 'name' => scalar $view->name, 'sql' => scalar $view->sql, 'fields' => scalar $view->fields, + keys %{$view->extra} ? ('extra' => { $view->extra } ) : (), + }; +} + +# ------------------------------------------------------------------- +sub view_index { + my $index = shift; + + return { + 'name' => scalar $index->name, + 'type' => scalar $index->type, + 'fields' => scalar $index->fields, + 'options' => scalar $index->options, + keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; } @@ -156,6 +213,6 @@ SQL::Translator, YAML, http://www.yaml.org/. =head1 AUTHORS darren chamberlain Edarren@cpan.orgE, -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =cut