From: Jon Jensen <jon@endpoint.com>
Date: Fri, 26 Apr 2013 14:10:16 +0000 (+0200)
Subject: Add JSON parser and producer modules
X-Git-Tag: v0.011017~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FSQL-Translator.git;a=commitdiff_plain;h=edc7ae1776a44b7530eb016b04ba038d37d10eb0

Add JSON parser and producer modules

These are cloned and adapted from their YAML counterparts.
---

diff --git a/Changes b/Changes
index 95aaf23..65561e5 100644
--- a/Changes
+++ b/Changes
@@ -10,6 +10,7 @@
 * Fix typos in error messages
 * Add SQL_TINYINT and SQL_BIGINT to the type map in
   SQL::Translator::Schema::Field
+* Add JSON parser and producer (Jon Jensen)
 
 # ----------------------------------------------------------
 # 0.11016 2012-10-09
diff --git a/Makefile.PL b/Makefile.PL
index 8a3183f..e63df5d 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -30,6 +30,7 @@ my $deps = {
     'XML::LibXML'              => '1.69',
   },
   test_requires => {
+    'JSON'                     => '2.0',
     'YAML'                     => '0.66',
     'XML::Writer'              => '0.500',
     'Test::More'               => '0.88',
diff --git a/lib/SQL/Translator/Parser/JSON.pm b/lib/SQL/Translator/Parser/JSON.pm
new file mode 100755
index 0000000..22742ad
--- /dev/null
+++ b/lib/SQL/Translator/Parser/JSON.pm
@@ -0,0 +1,140 @@
+package SQL::Translator::Parser::JSON;
+
+use strict;
+use warnings;
+our $VERSION = '1.00';
+
+use SQL::Translator::Schema;
+use SQL::Translator::Utils qw(header_comment);
+use Data::Dumper;
+use JSON;
+
+sub parse {
+    my ($translator, $data) = @_;
+    $data = from_json($data);
+    $data = $data->{'schema'};
+
+    warn "JSON data:", Dumper($data) if $translator->debug;
+
+    my $schema = $translator->schema;
+
+    #
+    # Tables
+    #
+    my @tables =
+        map   { $data->{'tables'}{ $_->[1] } }
+        sort  { $a->[0] <=> $b->[0] }
+        map   { [ $data->{'tables'}{ $_ }{'order'} || 0, $_ ] }
+        keys %{ $data->{'tables'} }
+    ;
+
+    for my $tdata ( @tables ) {
+
+        my $table = $schema->add_table(
+            map {
+              $tdata->{$_} ? ($_ => $tdata->{$_}) : ()
+            } (qw/name extra options/)
+        ) 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;
+            $table->primary_key( $fdata->{'name'} )
+                if $fdata->{'is_primary_key'};
+        }
+
+        for my $idata ( @{ $tdata->{'indices'} || [] } ) {
+            $table->add_index( %$idata ) or die $table->error;
+        }
+
+        for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
+            $table->add_constraint( %$cdata ) 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;
+    }
+
+    if ( my $tr_data = $data->{'translator'} ) {
+        $translator->add_drop_table( $tr_data->{'add_drop_table'} );
+        $translator->filename( $tr_data->{'filename'} );
+        $translator->no_comments( $tr_data->{'no_comments'} );
+        $translator->parser_args( $tr_data->{'parser_args'} );
+        $translator->producer_args( $tr_data->{'producer_args'} );
+        $translator->parser_type( $tr_data->{'parser_type'} );
+        $translator->producer_type( $tr_data->{'producer_type'} );
+        $translator->show_warnings( $tr_data->{'show_warnings'} );
+        $translator->trace( $tr_data->{'trace'} );
+    }
+
+    return 1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+SQL::Translator::Parser::JSON - Parse a JSON representation of a schema
+
+=head1 SYNOPSIS
+
+    use SQL::Translator;
+
+    my $translator = SQL::Translator->new(parser => "JSON");
+
+=head1 DESCRIPTION
+
+C<SQL::Translator::Parser::JSON> parses a schema serialized with JSON.
+
+=head1 AUTHORS
+
+Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Jon Jensen E<lt>jonj@cpan.orgE<gt>.
diff --git a/lib/SQL/Translator/Producer/JSON.pm b/lib/SQL/Translator/Producer/JSON.pm
new file mode 100644
index 0000000..0095316
--- /dev/null
+++ b/lib/SQL/Translator/Producer/JSON.pm
@@ -0,0 +1,192 @@
+package SQL::Translator::Producer::JSON;
+
+=head1 NAME
+
+SQL::Translator::Producer::JSON - A JSON producer for SQL::Translator
+
+=head1 SYNOPSIS
+
+  use SQL::Translator;
+
+  my $translator = SQL::Translator->new(producer => 'JSON');
+
+=head1 DESCRIPTION
+
+This module serializes a schema to a JSON string.
+
+=cut
+
+use strict;
+use warnings;
+our $VERSION = '1.00';
+
+use JSON;
+
+sub produce {
+    my $translator = shift;
+    my $schema     = $translator->schema;
+
+    return to_json({
+        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,
+        },
+        keys %{$schema->extra} ? ('extra' => { $schema->extra } ) : (),
+    }, {
+        allow_blessed => 1,
+        allow_unknown => 1,
+        %{$translator->producer_args},
+    });
+}
+
+sub view_table {
+    my $table = shift;
+
+    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
+        },
+        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 } ) : (),
+    };
+}
+
+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,
+        $field->is_auto_increment ? ('is_auto_increment' => 1) : (),
+        $field->comments ? ('comments' => $field->comments) : (),
+        keys %{$field->extra} ? ('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,
+        keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (),
+    };
+}
+
+sub view_trigger {
+    my $trigger = shift;
+
+    return {
+        'order'               => scalar $trigger->order,
+        'name'                => scalar $trigger->name,
+        'perform_action_when' => scalar $trigger->perform_action_when,
+        '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 } ) : (),
+    };
+}
+
+sub view_view {
+    my $view = shift;
+
+    return {
+        'order'  => scalar $view->order,
+        '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 } ) : (),
+    };
+}
+
+1;
+
+=head1 SEE ALSO
+
+SQL::Translator, JSON, http://www.json.org/.
+
+=head1 AUTHORS
+
+darren chamberlain E<lt>darren@cpan.orgE<gt>,
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Jon Jensen E<lt>jonj@cpan.orgE<gt>.
+
+=cut
diff --git a/t/23json.t b/t/23json.t
new file mode 100644
index 0000000..e0148ca
--- /dev/null
+++ b/t/23json.t
@@ -0,0 +1,304 @@
+use warnings;
+use strict;
+use Test::More;
+use Test::Differences;
+use Test::SQL::Translator qw(maybe_plan);
+use SQL::Translator;
+use FindBin '$Bin';
+
+BEGIN {
+    maybe_plan(
+        2,
+        'SQL::Translator::Parser::SQLite',
+        'SQL::Translator::Producer::JSON',
+    );
+}
+
+my $sqlt_version = $SQL::Translator::VERSION;
+my $json = <<JSON;
+{
+   "schema" : {
+      "procedures" : {},
+      "tables" : {
+         "person" : {
+            "constraints" : [
+               {
+                  "deferrable" : 1,
+                  "expression" : "",
+                  "fields" : [
+                     "person_id"
+                  ],
+                  "match_type" : "",
+                  "name" : "",
+                  "on_delete" : "",
+                  "on_update" : "",
+                  "options" : [],
+                  "reference_fields" : [],
+                  "reference_table" : "",
+                  "type" : "PRIMARY KEY"
+               },
+               {
+                  "deferrable" : 1,
+                  "expression" : "",
+                  "fields" : [
+                     "name"
+                  ],
+                  "match_type" : "",
+                  "name" : "u_name",
+                  "on_delete" : "",
+                  "on_update" : "",
+                  "options" : [],
+                  "reference_fields" : [],
+                  "reference_table" : "",
+                  "type" : "UNIQUE"
+               }
+            ],
+            "fields" : {
+               "age" : {
+                  "data_type" : "integer",
+                  "default_value" : null,
+                  "is_nullable" : 1,
+                  "is_primary_key" : 0,
+                  "is_unique" : 0,
+                  "name" : "age",
+                  "order" : "3",
+                  "size" : [
+                     "0"
+                  ]
+               },
+               "description" : {
+                  "data_type" : "text",
+                  "default_value" : null,
+                  "is_nullable" : 1,
+                  "is_primary_key" : 0,
+                  "is_unique" : 0,
+                  "name" : "description",
+                  "order" : "6",
+                  "size" : [
+                     "0"
+                  ]
+               },
+               "iq" : {
+                  "data_type" : "tinyint",
+                  "default_value" : "0",
+                  "is_nullable" : 1,
+                  "is_primary_key" : 0,
+                  "is_unique" : 0,
+                  "name" : "iq",
+                  "order" : "5",
+                  "size" : [
+                     "0"
+                  ]
+               },
+               "name" : {
+                  "data_type" : "varchar",
+                  "default_value" : null,
+                  "is_nullable" : 0,
+                  "is_primary_key" : 0,
+                  "is_unique" : 1,
+                  "name" : "name",
+                  "order" : "2",
+                  "size" : [
+                     "20"
+                  ]
+               },
+               "person_id" : {
+                  "data_type" : "INTEGER",
+                  "default_value" : null,
+                  "is_auto_increment" : 1,
+                  "is_nullable" : 0,
+                  "is_primary_key" : 1,
+                  "is_unique" : 0,
+                  "name" : "person_id",
+                  "order" : "1",
+                  "size" : [
+                     "0"
+                  ]
+               },
+               "weight" : {
+                  "data_type" : "double",
+                  "default_value" : null,
+                  "is_nullable" : 1,
+                  "is_primary_key" : 0,
+                  "is_unique" : 0,
+                  "name" : "weight",
+                  "order" : "4",
+                  "size" : [
+                     "11",
+                     "2"
+                  ]
+               }
+            },
+            "indices" : [],
+            "name" : "person",
+            "options" : [],
+            "order" : "1"
+         },
+         "pet" : {
+            "constraints" : [
+               {
+                  "deferrable" : 1,
+                  "expression" : "",
+                  "fields" : [],
+                  "match_type" : "",
+                  "name" : "",
+                  "on_delete" : "",
+                  "on_update" : "",
+                  "options" : [],
+                  "reference_fields" : [],
+                  "reference_table" : "",
+                  "type" : "CHECK"
+               },
+               {
+                  "deferrable" : 1,
+                  "expression" : "",
+                  "fields" : [
+                     "pet_id",
+                     "person_id"
+                  ],
+                  "match_type" : "",
+                  "name" : "",
+                  "on_delete" : "",
+                  "on_update" : "",
+                  "options" : [],
+                  "reference_fields" : [],
+                  "reference_table" : "",
+                  "type" : "PRIMARY KEY"
+               },
+               {
+                  "deferrable" : 1,
+                  "expression" : "",
+                  "fields" : [
+                     "person_id"
+                  ],
+                  "match_type" : "",
+                  "name" : "",
+                  "on_delete" : "",
+                  "on_update" : "",
+                  "options" : [],
+                  "reference_fields" : [
+                     "person_id"
+                  ],
+                  "reference_table" : "person",
+                  "type" : "FOREIGN KEY"
+               }
+            ],
+            "fields" : {
+               "age" : {
+                  "data_type" : "int",
+                  "default_value" : null,
+                  "is_nullable" : 1,
+                  "is_primary_key" : 0,
+                  "is_unique" : 0,
+                  "name" : "age",
+                  "order" : "4",
+                  "size" : [
+                     "0"
+                  ]
+               },
+               "name" : {
+                  "data_type" : "varchar",
+                  "default_value" : null,
+                  "is_nullable" : 1,
+                  "is_primary_key" : 0,
+                  "is_unique" : 0,
+                  "name" : "name",
+                  "order" : "3",
+                  "size" : [
+                     "30"
+                  ]
+               },
+               "person_id" : {
+                  "data_type" : "int",
+                  "default_value" : null,
+                  "is_nullable" : 0,
+                  "is_primary_key" : 1,
+                  "is_unique" : 0,
+                  "name" : "person_id",
+                  "order" : "2",
+                  "size" : [
+                     "0"
+                  ]
+               },
+               "pet_id" : {
+                  "data_type" : "int",
+                  "default_value" : null,
+                  "is_nullable" : 0,
+                  "is_primary_key" : 1,
+                  "is_unique" : 0,
+                  "name" : "pet_id",
+                  "order" : "1",
+                  "size" : [
+                     "0"
+                  ]
+               }
+            },
+            "indices" : [],
+            "name" : "pet",
+            "options" : [],
+            "order" : "2"
+         }
+      },
+      "triggers" : {
+         "pet_trig" : {
+            "action" : {
+               "for_each" : null,
+               "steps" : [
+                  "update pet set name=name"
+               ],
+               "when" : null
+            },
+            "database_events" : [
+               "insert"
+            ],
+            "fields" : null,
+            "name" : "pet_trig",
+            "on_table" : "pet",
+            "order" : "1",
+            "perform_action_when" : "after"
+         }
+      },
+      "views" : {
+         "person_pet" : {
+            "fields" : [],
+            "name" : "person_pet",
+            "order" : "1",
+            "sql" : "select pr.person_id, pr.name as person_name, pt.name as pet_name\\n  from   person pr, pet pt\\n  where  person.person_id=pet.pet_id\\n"
+         }
+      }
+   },
+   "translator" : {
+      "add_drop_table" : 0,
+      "filename" : null,
+      "no_comments" : 0,
+      "parser_args" : {},
+      "parser_type" : "SQL::Translator::Parser::SQLite",
+      "producer_args" : {
+         "canonical" : 1,
+         "pretty" : 1
+      },
+      "producer_type" : "SQL::Translator::Producer::JSON",
+      "show_warnings" : 0,
+      "trace" : 0,
+      "version" : "$sqlt_version"
+   }
+}
+JSON
+
+my $file = "$Bin/data/sqlite/create.sql";
+open my $fh, '<', $file or die "Can't read '$file': $!\n";
+local $/;
+my $data = <$fh>;
+my $tr = SQL::Translator->new(
+    parser => 'SQLite',
+    producer => 'JSON',
+    producer_args => {
+        canonical => 1,
+        pretty => 1,
+    },
+    data => $data,
+);
+
+my $out;
+ok( $out = $tr->translate, 'Translate SQLite to JSON' );
+eq_or_diff( $out, $json, 'JSON matches expected' );