diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index 58e7444c..10066b49 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -252,8 +252,23 @@ create : comment(s?) CREATE TEMPORARY(?) TABLE table_name '(' definition(s /,/) for my $def ( @{ $item[7] } ) { if ( $def->{'supertype'} eq 'column' ) { push @{ $tables{ $table_name }{'fields'} }, $def; + if (my $check = $def->{check}) { + my ($constraint) = grep { exists $_->{type} && $_->{type} eq 'check' } @{$def->{constraints}}; + push @{ $tables{ $table_name }{'constraints'} }, { + comments => $def->{comments}, + expression => $check, + fields => [ $def->{name} ], + on_conflict => $constraint->{on_conflict}, + type => 'check', + }; + } } elsif ( $def->{'supertype'} eq 'constraint' ) { + if ($def->{type} eq 'check') { + my $expression = $def->{expression}; + push @{$def->{fields}}, $_ + for (grep { $expression =~ m/\b\Q$_\E\b/ } map { $_->{name} } @{$tables{$table_name}{fields}}); + } push @{ $tables{ $table_name }{'constraints'} }, $def; } } @@ -289,7 +304,7 @@ column_def: comment(s?) NAME type(?) column_constraint_def(s?) $column->{'is_unique'} = 1; } elsif ( $c->{'type'} eq 'check' ) { - $column->{'check'} = $c->{'expression'}; + ($column->{'check'} = $c->{'expression'}) =~ s/(^\s*|\s$)//g; } elsif ( $c->{'type'} eq 'default' ) { $column->{'default'} = $c->{'value'}; @@ -344,11 +359,11 @@ column_constraint : NOT_NULL conflict_clause(?) } } | - CHECK_C '(' expr ')' conflict_clause(?) + CHECK_C '(' expr(s /(?^ui:(AND|OR))/) ')' conflict_clause(?) # ?^ in perl >= 5.14 { $return = { type => 'check', - expression => $item[3], + expression => join(' ', @{$item[3]}), on_conflict => $item[5][0], } } @@ -416,12 +431,14 @@ table_constraint : PRIMARY_KEY parens_field_list conflict_clause(?) } } | - CHECK_C '(' expr ')' conflict_clause(?) + CHECK_C '(' expr(s /(?^ui:(AND|OR))/) ')' conflict_clause(?) { + # trim whitespace + (my $exp = join(' ', @{$item[3]})) =~ s/(^\s*|\s*$)//g; $return = { supertype => 'constraint', type => 'check', - expression => $item[3], + expression => $exp, on_conflict => $item[5][0], } } @@ -478,7 +495,11 @@ column_list : field_name(s /,/) parens_value_list : '(' VALUE(s /,/) ')' { $item[2] } -expr : /[^)]* \( [^)]+ \) [^)]*/x # parens, balanced one deep +function_call : /(\w* ( \( ( (?:(?>[^()]+)|(?2))* ) \) ) )/x # from perldoc perlre + +expr : function_call '=' literal { $return = join ' ', @item[1..3] } + | function_call + | /[^)]* \( [^)]+ \) [^)]*/x # parens, balanced one deep | /[^)]+/ sort_order : /(ASC|DESC)/i @@ -538,6 +559,9 @@ nonstring : /[^;\'"]+/ statement_body : string | nonstring +literal : /[-+]?\d*\.?\d+(?:[eE]\d+)?/ + | string + trigger_step : /(select|delete|insert|update)/i statement_body(s?) SEMICOLON { $return = join( ' ', $item[1], join ' ', @{ $item[2] || [] } ) @@ -718,6 +742,7 @@ sub parse { on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'}, on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'}, ) or die $table->error; + $constraint->expression($cdata->{expression}) if defined $cdata->{expression} and $cdata->{expression} =~ m/\w+/; } } diff --git a/t/23json.t b/t/23json.t index 559a7598..5cf0a6e6 100644 --- a/t/23json.t +++ b/t/23json.t @@ -147,8 +147,8 @@ my $json = from_json(<import('parse'); @@ -49,6 +49,12 @@ my $file = "$Bin/data/sqlite/create.sql"; is($c1->reference_table, 'person', 'References person table'); is(join(',', $c1->reference_fields), 'person_id', 'References person_id field'); + my $c0 = shift @constraints; + is($c0->type, 'CHECK', 'CHECK constraint'); + is($c0->expression, 'age < 100', 'contraint expression'); + is_deeply([ $c0->field_names ], ['age'], 'fields that check refers to'); + is($c0->table, 'pet', 'table name is pet'); + my @views = $schema->get_views; is(scalar @views, 1, 'Parsed one views'); @@ -75,6 +81,13 @@ $file = "$Bin/data/sqlite/named.sql"; my @constraints = $t1->get_constraints; is(scalar @constraints, 5, '5 constraints on pet'); + my $c0 = $constraints[0]; + is($c0->type, 'CHECK', 'constraint has correct type'); + is($c0->name, 'age_under_100', 'constraint check has correct name'); + is_deeply([ $c0->field_names ], ['age'], 'fields that check refers to'); + is($c0->table, 'pet', 'table name is pet'); + is($c0->expression, 'age < 100 and age not in (101, 102)', 'constraint expression'); + my $c1 = $constraints[2]; is($c1->type, 'FOREIGN KEY', 'FK constraint'); is($c1->reference_table, 'person', 'References person table'); @@ -92,3 +105,45 @@ $file = "$Bin/data/sqlite/named.sql"; is($c3->on_delete, '', 'On delete not defined'); } + +$file = "$Bin/data/sqlite/checks.sql"; +{ + local $/; + open my $fh, "<$file" or die "Can't read file '$file': $!\n"; + my $data = <$fh>; + my $t = SQL::Translator->new(trace => 0, debug => 0); + parse($t, $data); + + my $schema = $t->schema; + + my @tables = $schema->get_tables; + is(scalar @tables, 2, 'Parsed one table'); + + is($tables[0]->name, 'pet', "'Pet' table"); + is($tables[1]->name, 'zoo_animal', "'Zoo Amimal' table"); + + for my $t1 (@tables) { + my @fields = $t1->get_fields; + is(scalar @fields, 4, 'Four fields in "pet" table'); + + my $visits = $fields[3]; + is($visits->name, 'vet_visits', 'field name correct'); + is($visits->default_value, '[]', 'default value is empty array'); + is($visits->is_nullable, 0, 'not null'); + + my @constraints = $t1->get_constraints; + is(scalar @constraints, 2, '2 constraints on pet'); + + my $c0 = $constraints[0]; + is($c0->type, 'CHECK', 'constraint has correct type'); + is_deeply([ $c0->field_names ], ['vet_visits'], 'fields that check refers to'); + is($c0->table, $t1->name, 'table name is pet'); + is($c0->expression, q{json_valid(vet_visits) and json_type(vet_visits) = 'array'}, 'constraint expression'); + + my $c1 = $constraints[1]; + is($c1->type, 'PRIMARY KEY', 'PK constraint'); + is($c1->table, $t1->name, 'pet table'); + is($c1->name, 'pk_pet', 'Constraint name pk_pet'); + is(join(',', $c1->fields), 'pet_id,person_id', 'References person_id field'); + } +} diff --git a/t/data/sqlite/checks.sql b/t/data/sqlite/checks.sql new file mode 100644 index 00000000..f46969a3 --- /dev/null +++ b/t/data/sqlite/checks.sql @@ -0,0 +1,16 @@ +create table pet ( + "pet_id" int, + "person_id" int, + "name" varchar(30), + "vet_visits" text not null check(json_valid(vet_visits) and json_type(vet_visits) = 'array') default '[]', + constraint pk_pet primary key (pet_id, person_id) +); + +create table zoo_animal ( + "pet_id" int, + "person_id" int, + "name" varchar(30), + "vet_visits" text not null default '[]', + constraint ck_json_array check(json_valid(vet_visits) and json_type(vet_visits) = 'array'), + constraint pk_pet primary key (pet_id, person_id) +);