lib/SQL/Translator/Producer/YAML.pm

   1 package SQL::Translator::Producer::YAML;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Producer::YAML - A YAML producer for SQL::Translator
   6
   7 =head1 SYNOPSIS
   8
   9   use SQL::Translator;
  10
  11   my $translator = SQL::Translator->new(producer => 'YAML');
  12
  13 =head1 DESCRIPTION
  14
  15 This module uses YAML to serialize a schema to a string so that it
  16 can be saved to disk.  Serializing a schema and then calling producers
  17 on the stored can realize significant performance gains when parsing
  18 takes a long time.
  19
  20 =cut
  21
  22 use strict;
  23 use warnings;
  24 our $VERSION = '1.59';
  25
  26 use YAML qw(Dump);
  27
  28 sub produce {
  29     my $translator = shift;
  30     my $schema     = $translator->schema;
  31
  32     return Dump({
  33         schema => {
  34             tables => {
  35                 map { ($_->name => view_table($_)) }
  36                     $schema->get_tables,
  37             },
  38             views => {
  39                 map { ($_->name => view_view($_)) }
  40                     $schema->get_views,
  41             },
  42             triggers => {
  43                 map { ($_->name => view_trigger($_)) }
  44                     $schema->get_triggers,
  45             },
  46             procedures => {
  47                 map { ($_->name => view_procedure($_)) }
  48                     $schema->get_procedures,
  49             },
  50         },
  51         translator => {
  52             add_drop_table => $translator->add_drop_table,
  53             filename       => $translator->filename,
  54             no_comments    => $translator->no_comments,
  55             parser_args    => $translator->parser_args,
  56             producer_args  => $translator->producer_args,
  57             parser_type    => $translator->parser_type,
  58             producer_type  => $translator->producer_type,
  59             show_warnings  => $translator->show_warnings,
  60             trace          => $translator->trace,
  61             version        => $translator->version,
  62         },
  63         keys %{$schema->extra} ? ('extra' => { $schema->extra } ) : (),
  64     });
  65 }
  66
  67 sub view_table {
  68     my $table = shift;
  69
  70     return {
  71         'name'        => $table->name,
  72         'order'       => $table->order,
  73         'options'     => $table->options  || [],
  74         $table->comments ? ('comments'    => [ $table->comments ] ) : (),
  75         'constraints' => [
  76             map { view_constraint($_) } $table->get_constraints
  77         ],
  78         'indices'     => [
  79             map { view_index($_) } $table->get_indices
  80         ],
  81         'fields'      => {
  82             map { ($_->name => view_field($_)) }
  83                 $table->get_fields
  84         },
  85         keys %{$table->extra} ? ('extra' => { $table->extra } ) : (),
  86     };
  87 }
  88
  89 sub view_constraint {
  90     my $constraint = shift;
  91
  92     return {
  93         'deferrable'       => scalar $constraint->deferrable,
  94         'expression'       => scalar $constraint->expression,
  95         'fields'           => [ map { ref $_ ? $_->name : $_ } $constraint->field_names ],
  96         'match_type'       => scalar $constraint->match_type,
  97         'name'             => scalar $constraint->name,
  98         'options'          => scalar $constraint->options,
  99         'on_delete'        => scalar $constraint->on_delete,
 100         'on_update'        => scalar $constraint->on_update,
 101         'reference_fields' => [ map { ref $_ ? $_->name : $_ } $constraint->reference_fields ],
 102         'reference_table'  => scalar $constraint->reference_table,
 103         'type'             => scalar $constraint->type,
 104         keys %{$constraint->extra} ? ('extra' => { $constraint->extra } ) : (),
 105     };
 106 }
 107
 108 sub view_field {
 109     my $field = shift;
 110
 111     return {
 112         'order'             => scalar $field->order,
 113         'name'              => scalar $field->name,
 114         'data_type'         => scalar $field->data_type,
 115         'size'              => [ $field->size ],
 116         'default_value'     => scalar $field->default_value,
 117         'is_nullable'       => scalar $field->is_nullable,
 118         'is_primary_key'    => scalar $field->is_primary_key,
 119         'is_unique'         => scalar $field->is_unique,
 120         $field->is_auto_increment ? ('is_auto_increment' => 1) : (),
 121         $field->comments ? ('comments' => [ $field->comments ]) : (),
 122         keys %{$field->extra} ? ('extra' => { $field->extra } ) : (),
 123     };
 124 }
 125
 126 sub view_procedure {
 127     my $procedure = shift;
 128
 129     return {
 130         'order'      => scalar $procedure->order,
 131         'name'       => scalar $procedure->name,
 132         'sql'        => scalar $procedure->sql,
 133         'parameters' => scalar $procedure->parameters,
 134         'owner'      => scalar $procedure->owner,
 135         'comments'   => scalar $procedure->comments,
 136         keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (),
 137     };
 138 }
 139
 140 sub view_trigger {
 141     my $trigger = shift;
 142
 143     return {
 144         'order'               => scalar $trigger->order,
 145         'name'                => scalar $trigger->name,
 146         'perform_action_when' => scalar $trigger->perform_action_when,
 147         'database_events'     => scalar $trigger->database_events,
 148         'fields'              => scalar $trigger->fields,
 149         'on_table'            => scalar $trigger->on_table,
 150         'action'              => scalar $trigger->action,
 151         'scope'               => scalar $trigger->scope,
 152         keys %{$trigger->extra} ? ('extra' => { $trigger->extra } ) : (),
 153     };
 154 }
 155
 156 sub view_view {
 157     my $view = shift;
 158
 159     return {
 160         'order'  => scalar $view->order,
 161         'name'   => scalar $view->name,
 162         'sql'    => scalar $view->sql,
 163         'fields' => scalar $view->fields,
 164         keys %{$view->extra} ? ('extra' => { $view->extra } ) : (),
 165     };
 166 }
 167
 168 sub view_index {
 169     my $index = shift;
 170
 171     return {
 172         'name'      => scalar $index->name,
 173         'type'      => scalar $index->type,
 174         'fields'    => scalar $index->fields,
 175         'options'   => scalar $index->options,
 176         keys %{$index->extra} ? ('extra' => { $index->extra } ) : (),
 177     };
 178 }
 179
 180 1;
 181
 182 =head1 SEE ALSO
 183
 184 SQL::Translator, YAML, http://www.yaml.org/.
 185
 186 =head1 AUTHORS
 187
 188 darren chamberlain E<lt>darren@cpan.orgE<gt>,
 189 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 190
 191 =cut