From 8958be7ad875f9e8841a00ec32559ae85c405ef9 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Mon, 3 Aug 2015 23:19:42 -0400 Subject: [PATCH 1/4] add table comment parsing to sqlite parser --- lib/SQL/Translator/Parser/SQLite.pm | 15 ++++++++------- t/27sqlite-parser.t | 8 +++++++- t/data/sqlite/create.sql | 3 +++ 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index b3e81ae3a..d79d8a1be 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -147,7 +147,7 @@ our @EXPORT_OK = qw(parse); our $GRAMMAR = <<'END_OF_GRAMMAR'; { - my ( %tables, $table_order, @table_comments, @views, @triggers ); + my ( %tables, $table_order, @views, @triggers ); sub _err { my $max_lines = 5; @@ -179,8 +179,8 @@ eofile : /^\Z/ statement : begin_transaction | commit | drop - | comment | create + | comment | /^\Z/ | { _err ($thisline, $text) } begin_transaction : /begin/i TRANSACTION(?) SEMICOLON @@ -239,16 +239,17 @@ create : CREATE TEMPORARY(?) UNIQUE(?) INDEX NAME ON table_name parens_field_lis # # Create Table # -create : CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLON +create : comment(s?) CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) ')' SEMICOLON { - my $db_name = $item[4]->{'db_name'} || ''; - my $table_name = $item[4]->{'name'}; + my $db_name = $item[5]->{'db_name'} || ''; + my $table_name = $item[5]->{'name'}; $tables{ $table_name }{'name'} = $table_name; - $tables{ $table_name }{'is_temporary'} = $item[2][0] ? 1 : 0; + $tables{ $table_name }{'is_temporary'} = $item[3][0] ? 1 : 0; + $tables{ $table_name }{'comments'} = $item[1]; $tables{ $table_name }{'order'} = ++$table_order; - for my $def ( @{ $item[6] } ) { + for my $def ( @{ $item[7] } ) { if ( $def->{'supertype'} eq 'column' ) { push @{ $tables{ $table_name }{'fields'} }, $def; } diff --git a/t/27sqlite-parser.t b/t/27sqlite-parser.t index 5f61ea7bd..5efe08e5d 100644 --- a/t/27sqlite-parser.t +++ b/t/27sqlite-parser.t @@ -10,7 +10,7 @@ use SQL::Translator; use SQL::Translator::Schema::Constants; BEGIN { - maybe_plan(25, + maybe_plan(26, 'SQL::Translator::Parser::SQLite'); } SQL::Translator::Parser::SQLite->import('parse'); @@ -31,6 +31,12 @@ my $file = "$Bin/data/sqlite/create.sql"; my $t1 = shift @tables; is( $t1->name, 'person', "'Person' table" ); + is_deeply( [ $t1->comments ], + [ q(table comment 1), + q(table comment 2), + q(table comment 3) + ], + 'person table comments' ); my @fields = $t1->get_fields; is( scalar @fields, 6, 'Six fields in "person" table'); diff --git a/t/data/sqlite/create.sql b/t/data/sqlite/create.sql index f7a397fca..79c36174c 100644 --- a/t/data/sqlite/create.sql +++ b/t/data/sqlite/create.sql @@ -1,3 +1,6 @@ +-- table comment 1 +-- table comment 2 +-- table comment 3 create table person ( person_id INTEGER PRIMARY KEY AUTOINCREMENT, 'name' varchar(20) not null, From 94cf2d547add09f18d501b335e2d3af955fc141c Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Tue, 4 Aug 2015 17:46:46 -0400 Subject: [PATCH 2/4] JSON & YAML parsers now track table comments --- lib/SQL/Translator/Parser/JSON.pm | 4 ++++ lib/SQL/Translator/Parser/YAML.pm | 3 +++ 2 files changed, 7 insertions(+) diff --git a/lib/SQL/Translator/Parser/JSON.pm b/lib/SQL/Translator/Parser/JSON.pm index 22742ad22..d2f9b83cc 100644 --- a/lib/SQL/Translator/Parser/JSON.pm +++ b/lib/SQL/Translator/Parser/JSON.pm @@ -56,6 +56,10 @@ sub parse { for my $cdata ( @{ $tdata->{'constraints'} || [] } ) { $table->add_constraint( %$cdata ) or die $table->error; } + + $table->comments( $tdata->{'comments' } ) + if exists $tdata->{'comments'}; + } # diff --git a/lib/SQL/Translator/Parser/YAML.pm b/lib/SQL/Translator/Parser/YAML.pm index 462ddcde8..e2c71704b 100644 --- a/lib/SQL/Translator/Parser/YAML.pm +++ b/lib/SQL/Translator/Parser/YAML.pm @@ -56,6 +56,9 @@ sub parse { for my $cdata ( @{ $tdata->{'constraints'} || [] } ) { $table->add_constraint( %$cdata ) or die $table->error; } + + $table->comments( $tdata->{'comments' } ) + if exists $tdata->{'comments'}; } # From 05952052b554124cf326416fdb96f5ee0d22067e Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Tue, 4 Aug 2015 17:50:18 -0400 Subject: [PATCH 3/4] bugfix: JSON and YAML producers called comments method in wrong context Both the JSON and YAML producers called the Table and Field comments method in list context while constructing a hash, assuming they would return a single value. They don't. In list context the comments methods return a list of comments. This led to "odd number of hash element" errors if the comments method returned an even number of elements. In scalar context the comments methods return a string composed of the concatenation of comments. This context was explicitly used when producing procedure comments. However, since the JSON and YAML formats support arrays, their producers should output the comments as arrays to avoid loss of information. To that end, all comments output are now encoded as arrays. --- lib/SQL/Translator/Producer/JSON.pm | 10 +++++----- lib/SQL/Translator/Producer/YAML.pm | 10 +++++----- t/23json.t | 1 + t/24yaml.t | 4 ++++ 4 files changed, 15 insertions(+), 10 deletions(-) diff --git a/lib/SQL/Translator/Producer/JSON.pm b/lib/SQL/Translator/Producer/JSON.pm index 0095316d3..2f63d7d4d 100644 --- a/lib/SQL/Translator/Producer/JSON.pm +++ b/lib/SQL/Translator/Producer/JSON.pm @@ -72,7 +72,7 @@ sub view_table { 'name' => $table->name, 'order' => $table->order, 'options' => $table->options || [], - $table->comments ? ('comments' => $table->comments ) : (), + $table->comments ? ('comments' => [ $table->comments ] ) : (), 'constraints' => [ map { view_constraint($_) } $table->get_constraints ], @@ -119,8 +119,8 @@ sub view_field { '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 } ) : (), + $field->comments ? ('comments' => [ $field->comments ]) : (), + keys %{$field->extra} ? ('extra' => { $field->extra } ) : (), }; } @@ -133,8 +133,8 @@ sub view_procedure { 'sql' => scalar $procedure->sql, 'parameters' => scalar $procedure->parameters, 'owner' => scalar $procedure->owner, - 'comments' => scalar $procedure->comments, - keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (), + $procedure->comments ? ('comments' => [ $procedure->comments ] ) : (), + keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (), }; } diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index 177cbdf65..7ac1e4fe5 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -71,7 +71,7 @@ sub view_table { 'name' => $table->name, 'order' => $table->order, 'options' => $table->options || [], - $table->comments ? ('comments' => $table->comments ) : (), + $table->comments ? ('comments' => [ $table->comments ] ) : (), 'constraints' => [ map { view_constraint($_) } $table->get_constraints ], @@ -118,8 +118,8 @@ sub view_field { '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 } ) : (), + $field->comments ? ('comments' => [ $field->comments ]) : (), + keys %{$field->extra} ? ('extra' => { $field->extra } ) : (), }; } @@ -132,8 +132,8 @@ sub view_procedure { 'sql' => scalar $procedure->sql, 'parameters' => scalar $procedure->parameters, 'owner' => scalar $procedure->owner, - 'comments' => scalar $procedure->comments, - keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (), + $procedure->comments ? ('comments' => [ $procedure->comments ] ) : (), + keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (), }; } diff --git a/t/23json.t b/t/23json.t index 0b063e2cc..33d20fc2a 100644 --- a/t/23json.t +++ b/t/23json.t @@ -22,6 +22,7 @@ my $json = to_json(from_json(< 1, pretty => 1 }); "procedures" : {}, "tables" : { "person" : { + "comments" : [ "table comment 1", "table comment 2", "table comment 3" ], "constraints" : [ { "deferrable" : 1, diff --git a/t/24yaml.t b/t/24yaml.t index 08757d9f4..e2aa65d18 100644 --- a/t/24yaml.t +++ b/t/24yaml.t @@ -20,6 +20,10 @@ schema: procedures: {} tables: person: + comments: + - table comment 1 + - table comment 2 + - table comment 3 constraints: - deferrable: 1 expression: '' From d28ff88a69a08060aac9ad8008d80a8eb6a805df Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 4 Sep 2015 15:50:40 -0400 Subject: [PATCH 4/4] remove introduced tabs --- lib/SQL/Translator/Parser/JSON.pm | 4 ++-- lib/SQL/Translator/Parser/YAML.pm | 4 ++-- t/27sqlite-parser.t | 10 +++++----- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/lib/SQL/Translator/Parser/JSON.pm b/lib/SQL/Translator/Parser/JSON.pm index d2f9b83cc..a8e47d0e1 100644 --- a/lib/SQL/Translator/Parser/JSON.pm +++ b/lib/SQL/Translator/Parser/JSON.pm @@ -57,8 +57,8 @@ sub parse { $table->add_constraint( %$cdata ) or die $table->error; } - $table->comments( $tdata->{'comments' } ) - if exists $tdata->{'comments'}; + $table->comments( $tdata->{'comments' } ) + if exists $tdata->{'comments'}; } diff --git a/lib/SQL/Translator/Parser/YAML.pm b/lib/SQL/Translator/Parser/YAML.pm index e2c71704b..d41270fc7 100644 --- a/lib/SQL/Translator/Parser/YAML.pm +++ b/lib/SQL/Translator/Parser/YAML.pm @@ -57,8 +57,8 @@ sub parse { $table->add_constraint( %$cdata ) or die $table->error; } - $table->comments( $tdata->{'comments' } ) - if exists $tdata->{'comments'}; + $table->comments( $tdata->{'comments' } ) + if exists $tdata->{'comments'}; } # diff --git a/t/27sqlite-parser.t b/t/27sqlite-parser.t index 5efe08e5d..b568f47dc 100644 --- a/t/27sqlite-parser.t +++ b/t/27sqlite-parser.t @@ -32,11 +32,11 @@ my $file = "$Bin/data/sqlite/create.sql"; my $t1 = shift @tables; is( $t1->name, 'person', "'Person' table" ); is_deeply( [ $t1->comments ], - [ q(table comment 1), - q(table comment 2), - q(table comment 3) - ], - 'person table comments' ); + [ q(table comment 1), + q(table comment 2), + q(table comment 3) + ], + 'person table comments' ); my @fields = $t1->get_fields; is( scalar @fields, 6, 'Six fields in "person" table');