These are cloned and adapted from their YAML counterparts.
* 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
'XML::LibXML' => '1.69',
},
test_requires => {
+ 'JSON' => '2.0',
'YAML' => '0.66',
'XML::Writer' => '0.500',
'Test::More' => '0.88',
--- /dev/null
+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>.
--- /dev/null
+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
--- /dev/null
+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' );
projects / dbsrgits/SQL-Translator.git / commitdiff