lib/SQL/Translator/Producer/JSON.pm

   1 package SQL::Translator::Producer::JSON;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Producer::JSON - A JSON producer for SQL::Translator
   6
   7 =head1 SYNOPSIS
   8
   9   use SQL::Translator;
  10
  11   my $translator = SQL::Translator->new(producer => 'JSON');
  12
  13 =head1 DESCRIPTION
  14
  15 This module serializes a schema to a JSON string.
  16
  17 =cut
  18
  19 use strict;
  20 use warnings;
  21 our $VERSION = '1.00';
  22
  23 use JSON;
  24
  25 sub produce {
  26     my $translator = shift;
  27     my $schema     = $translator->schema;
  28
  29     return to_json({
  30         schema => {
  31             tables => {
  32                 map { ($_->name => view_table($_)) }
  33                     $schema->get_tables,
  34             },
  35             views => {
  36                 map { ($_->name => view_view($_)) }
  37                     $schema->get_views,
  38             },
  39             triggers => {
  40                 map { ($_->name => view_trigger($_)) }
  41                     $schema->get_triggers,
  42             },
  43             procedures => {
  44                 map { ($_->name => view_procedure($_)) }
  45                     $schema->get_procedures,
  46             },
  47         },
  48         translator => {
  49             add_drop_table => $translator->add_drop_table,
  50             filename       => $translator->filename,
  51             no_comments    => $translator->no_comments,
  52             parser_args    => $translator->parser_args,
  53             producer_args  => $translator->producer_args,
  54             parser_type    => $translator->parser_type,
  55             producer_type  => $translator->producer_type,
  56             show_warnings  => $translator->show_warnings,
  57             trace          => $translator->trace,
  58             version        => $translator->version,
  59         },
  60         keys %{$schema->extra} ? ('extra' => { $schema->extra } ) : (),
  61     }, {
  62         allow_blessed => 1,
  63         allow_unknown => 1,
  64         %{$translator->producer_args},
  65     });
  66 }
  67
  68 sub view_table {
  69     my $table = shift;
  70
  71     return {
  72         'name'        => $table->name,
  73         'order'       => $table->order,
  74         'options'     => $table->options  || [],
  75         $table->comments ? ('comments'    => [ $table->comments ] ) : (),
  76         'constraints' => [
  77             map { view_constraint($_) } $table->get_constraints
  78         ],
  79         'indices'     => [
  80             map { view_index($_) } $table->get_indices
  81         ],
  82         'fields'      => {
  83             map { ($_->name => view_field($_)) }
  84                 $table->get_fields
  85         },
  86         keys %{$table->extra} ? ('extra' => { $table->extra } ) : (),
  87     };
  88 }
  89
  90 sub view_constraint {
  91     my $constraint = shift;
  92
  93     return {
  94         'deferrable'       => scalar $constraint->deferrable,
  95         'expression'       => scalar $constraint->expression,
  96         'fields'           => [ map { ref $_ ? $_->name : $_ } $constraint->field_names ],
  97         'match_type'       => scalar $constraint->match_type,
  98         'name'             => scalar $constraint->name,
  99         'options'          => scalar $constraint->options,
 100         'on_delete'        => scalar $constraint->on_delete,
 101         'on_update'        => scalar $constraint->on_update,
 102         'reference_fields' => [ map { ref $_ ? $_->name : $_ } $constraint->reference_fields ],
 103         'reference_table'  => scalar $constraint->reference_table,
 104         'type'             => scalar $constraint->type,
 105         keys %{$constraint->extra} ? ('extra' => { $constraint->extra } ) : (),
 106     };
 107 }
 108
 109 sub view_field {
 110     my $field = shift;
 111
 112     return {
 113         'order'             => scalar $field->order,
 114         'name'              => scalar $field->name,
 115         'data_type'         => scalar $field->data_type,
 116         'size'              => [ $field->size ],
 117         'default_value'     => scalar $field->default_value,
 118         'is_nullable'       => scalar $field->is_nullable,
 119         'is_primary_key'    => scalar $field->is_primary_key,
 120         'is_unique'         => scalar $field->is_unique,
 121         $field->is_auto_increment ? ('is_auto_increment' => 1) : (),
 122         $field->comments ? ('comments' => [ $field->comments ]) : (),
 123         keys %{$field->extra} ? ('extra' => { $field->extra } ) : (),
 124     };
 125 }
 126
 127 sub view_procedure {
 128     my $procedure = shift;
 129
 130     return {
 131         'order'      => scalar $procedure->order,
 132         'name'       => scalar $procedure->name,
 133         'sql'        => scalar $procedure->sql,
 134         'parameters' => scalar $procedure->parameters,
 135         'owner'      => scalar $procedure->owner,
 136         'comments'   => scalar $procedure->comments,
 137         keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (),
 138     };
 139 }
 140
 141 sub view_trigger {
 142     my $trigger = shift;
 143
 144     return {
 145         'order'               => scalar $trigger->order,
 146         'name'                => scalar $trigger->name,
 147         'perform_action_when' => scalar $trigger->perform_action_when,
 148         'database_events'     => scalar $trigger->database_events,
 149         'fields'              => scalar $trigger->fields,
 150         'on_table'            => scalar $trigger->on_table,
 151         'action'              => scalar $trigger->action,
 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, JSON, http://www.json.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 Jon Jensen E<lt>jonj@cpan.orgE<gt>.
 191
 192 =cut