Skip Menu |
 

This queue is for tickets about the SQL-Translator CPAN distribution.

Report information
The Basics
Id: 33673
Status: new
Priority: 0/
Queue: SQL-Translator

People
Owner: Nobody in particular
Requestors: DROLSKY [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: [PATCH] - misc Pg parser improvements
Download (untitled) / with headers
text/plain 694b
The attached patch implements a few improvements to the Pg parser ... * Handles CREATE DOMAIN and CREATE TYPE ... AS ENUM - this is done by dynamically extending the parser to register new types. For domains, the returned data for the type is based on the underlying pg type of the domain. This should work for translating to other database types, at least. * The "parens_word_list" rule which was being used for parsing things like column lists in foreign keys did not allow for quoted words, so it failed to parse relatively simple foreign key definitions. * Constraint names were being dropped entirely because of a little buglet in the action. I also added tests for all of the above.
Subject: sqlt.diff
Download sqlt.diff
text/x-diff 6k
diff -ru ../SQL-Translator-0.0900/lib/SQL/Translator/Parser/PostgreSQL.pm ./lib/SQL/Translator/Parser/PostgreSQL.pm --- ../SQL-Translator-0.0900/lib/SQL/Translator/Parser/PostgreSQL.pm 2008-02-21 04:26:58.000000000 -0600 +++ ./lib/SQL/Translator/Parser/PostgreSQL.pm 2008-02-28 16:03:24.000000000 -0600 @@ -272,6 +272,25 @@ # # Create anything else (e.g., domain, etc.) # +create : CREATE DOMAIN WORD /as/i data_type column_constraint(?) ';' + { + $thisparser->{local}{types}{ $item[3] } = $item{data_type}; + + $thisparser->Extend( "pg_data_type : '$item[3]' { \$return = \$thisparser->{local}{types}{ $item[3] } }" ); + } + +create : CREATE TYPE WORD /as/i /enum/i parens_value_list ';' + { + $thisparser->{local}{types}{ $item[3] } = { + type => 'enum', + extra => { + allowed => [ map { s/^\'|\'$//g; $_ } @{ $item{parens_value_list} } ], + }, + }; + + $thisparser->Extend( "pg_data_type : '$item[3]' { \$return = \$thisparser->{local}{types}{ $item[3] } }" ); + } + create : CREATE WORD /[^;]+/ ';' { @table_comments = (); } @@ -385,6 +404,7 @@ name => $item{'field_name'}, data_type => $item{'data_type'}{'type'}, size => $item{'data_type'}{'size'}, + extra => $item{'data_type'}{'extra'}, is_nullable => $is_nullable, default => $default->{'value'}, constraints => [ @constraints ], @@ -441,7 +461,7 @@ /primary key/i { $return = { type => 'primary_key' } } | - /check/i '(' /[^)]+/ ')' + /check/i '(' /[^)]+/ ')' { $return = { type => 'check', expression => $item[3] } } | /references/i table_name parens_word_list(?) match_type(?) key_action(s?) @@ -605,7 +625,7 @@ parens_value_list : '(' VALUE(s /,/) ')' { $item[2] } -parens_word_list : '(' WORD(s /,/) ')' +parens_word_list : '(' name_with_opt_quotes(s /,/) ')' { $item[2] } field_size : '(' num_range ')' { $item{'num_range'} } @@ -624,7 +644,7 @@ my @comments = ( @{ $item[1] }, @{ $item[-1] } ); $return = { - name => $item{'constraint_name'}[0] || '', + name => $item{'constraint_name(?)'}[0] || '', supertype => 'constraint', type => $type, fields => $type ne 'check' ? $fields : [], @@ -945,6 +965,10 @@ COPY : /copy/i +DOMAIN : /domain/i + +TYPE : /type/i + INTEGER : /\d+/ WORD : /\w+/ Only in .: RD_TRACE diff -ru ../SQL-Translator-0.0900/t/14postgres-parser.t ./t/14postgres-parser.t --- ../SQL-Translator-0.0900/t/14postgres-parser.t 2008-02-21 04:26:58.000000000 -0600 +++ ./t/14postgres-parser.t 2008-02-28 15:19:26.000000000 -0600 @@ -8,7 +8,7 @@ use Test::SQL::Translator qw(maybe_plan); BEGIN { - maybe_plan(117, 'SQL::Translator::Parser::PostgreSQL'); + maybe_plan(129, 'SQL::Translator::Parser::PostgreSQL'); SQL::Translator::Parser::PostgreSQL->import('parse'); } @@ -40,6 +40,15 @@ check (f_int between 1 and 5) ); + create domain thingy as varchar(200); + + create type enumed as enum ( 'a', 'b' ); + + create table t_test3 ( + f_domain thingy, + f_enum enumed + ); + alter table t_test1 add f_fk2 integer; alter table only t_test1 add constraint c_u1 unique (f_varchar); @@ -47,6 +56,9 @@ alter table t_test1 add constraint "c_fk2" foreign key (f_fk2) references t_test2 (f_id) on update no action on delete cascade; + alter table "t_test1" add constraint "c_fk3" foreign key ("f_fk2") + references "t_test2" ("f_id") on update no action on delete cascade; + alter table t_test1 drop column f_dropped restrict; alter table t_test1 alter column f_fk2 set default 'FOO'; @@ -76,11 +88,12 @@ $| = 1; my $data = parse( $t, $sql ); + my $schema = $t->schema; isa_ok( $schema, 'SQL::Translator::Schema', 'Schema object' ); my @tables = $schema->get_tables; -is( scalar @tables, 2, 'Two tables' ); +is( scalar @tables, 3, 'Three tables' ); my $t1 = shift @tables; is( $t1->name, 't_test1', 'Table t_test1 exists' ); @@ -190,7 +203,7 @@ # is( $fk_ref2->reference_table, 't_test2', 'FK is to "t_test2" table' ); my @t1_constraints = $t1->get_constraints; -is( scalar @t1_constraints, 8, '8 constraints on t_test1' ); +is( scalar @t1_constraints, 9, '9 constraints on t_test1' ); my $c1 = $t1_constraints[0]; is( $c1->type, PRIMARY_KEY, 'First constraint is PK' ); @@ -208,12 +221,22 @@ my $c4 = $t1_constraints[6]; is( $c4->type, FOREIGN_KEY, 'Fourth constraint is foreign key' ); +is( $c4->name, 'c_fk2', 'Fourth constraint is named "c_fk2"' ); is( join(',', $c4->fields), 'f_fk2', 'Constraint is on field "f_fk2"' ); is( $c4->reference_table, 't_test2', 'Constraint is to table "t_test2"' ); is( join(',', $c4->reference_fields), 'f_id', 'Constraint is to field "f_id"' ); is( $c4->on_delete, 'cascade', 'On delete: cascade' ); is( $c4->on_update, 'no_action', 'On delete: no action' ); +my $c5 = $t1_constraints[7]; +is( $c5->type, FOREIGN_KEY, 'Fifth constraint is foreign key' ); +is( $c5->name, 'c_fk3', 'Fifth constraint is named "c_fk3"' ); +is( join(',', $c5->fields), 'f_fk2', 'Constraint is on field "f_fk2"' ); +is( $c5->reference_table, 't_test2', 'Constraint is to table "t_test2"' ); +is( join(',', $c5->reference_fields), 'f_id', 'Constraint is to field "f_id"' ); +is( $c5->on_delete, 'cascade', 'On delete: cascade' ); +is( $c5->on_update, 'no_action', 'On delete: no action' ); + my $t2 = shift @tables; is( $t2->name, 't_test2', 'Table t_test2 exists' ); @@ -255,3 +278,13 @@ my $t2_c3 = shift @t2_constraints; is( $t2_c3->type, CHECK_C, "Constraint is a 'CHECK'" ); + +my $t3 = shift @tables; +is( $t3->name, 't_test3', 'Table t_test3 exists' ); + +my @t3_fields = $t3->get_fields; +is( scalar @t3_fields, 2, '2 fields in t_test3' ); + +my $t3_f1 = shift @t3_fields; +is( $t3_f1->name, 'f_domain', 'First field is "f_domain"' ); +is( $t3_f1->data_type, 'varchar', 'First field is a "varchar"' );


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.