Added rules to catch common (but useless) statements.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / Oracle.pm
CommitLineData
17cae8ab 1package SQL::Translator::Parser::Oracle;
2
3# -------------------------------------------------------------------
4# $Id: Oracle.pm,v 1.1 2003-04-10 03:09:28 kycl4rk Exp $
5# -------------------------------------------------------------------
6# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
7#
8# This program is free software; you can redistribute it and/or
9# modify it under the terms of the GNU General Public License as
10# published by the Free Software Foundation; version 2.
11#
12# This program is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15# General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program; if not, write to the Free Software
19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
20# 02111-1307 USA
21# -------------------------------------------------------------------
22
23=head1 NAME
24
25SQL::Translator::Parser::Oracle - parser for Oracle
26
27=head1 SYNOPSIS
28
29 use SQL::Translator;
30 use SQL::Translator::Parser::Oracle;
31
32 my $translator = SQL::Translator->new;
33 $translator->parser("SQL::Translator::Parser::Oracle");
34
35=head1 DESCRIPTION
36
37From http://www.ss64.com/ora/table_c.html:
38
39 CREATE [GLOBAL TEMPORARY] TABLE [schema.]table (tbl_defs,...)
40 [ON COMMIT {DELETE|PRESERVE} ROWS]
41 [storage_options | CLUSTER cluster_name (col1, col2,... )
42 | ORGANIZATION {HEAP [storage_options]
43 | INDEX idx_organized_tbl_clause}]
44 [LOB_storage_clause][varray_clause][nested_storage_clause]
45 partitioning_options
46 [[NO]CACHE] [[NO]MONITORING] [PARALLEL parallel_clause]
47 [ENABLE enable_clause | DISABLE disable_clause]
48 [AS subquery]
49
50tbl_defs:
51 column datatype [DEFAULT expr] [column_constraint(s)]
52 table_constraint
53 table_ref_constraint
54
55storage_options:
56 PCTFREE int
57 PCTUSED int
58 INITTRANS int
59 MAXTRANS int
60 STORAGE storage_clause
61 TABLESPACE tablespace
62 [LOGGING|NOLOGGING]
63
64idx_organized_tbl_clause:
65 storage_option(s) [PCTTHRESHOLD int]
66 [COMPRESS int|NOCOMPRESS]
67 [ [INCLUDING column_name] OVERFLOW [storage_option(s)] ]
68
69nested_storage_clause:
70 NESTED TABLE nested_item STORE AS storage_table
71 [RETURN AS {LOCATOR|VALUE} ]
72
73partitioning_options:
74 Partition_clause {ENABLE|DISABLE} ROW MOVEMENT
75
76Column Constraints
77(http://www.ss64.com/ora/clause_constraint_col.html)
78
79 CONSTRAINT constrnt_name {UNIQUE|PRIMARY KEY} constrnt_state
80
81 CONSTRAINT constrnt_name CHECK(condition) constrnt_state
82
83 CONSTRAINT constrnt_name [NOT] NULL constrnt_state
84
85 CONSTRAINT constrnt_name REFERENCES [schema.]table[(column)]
86 [ON DELETE {CASCADE|SET NULL}] constrnt_state
87
88constrnt_state
89 [[NOT] DEFERRABLE] [INITIALLY {IMMEDIATE|DEFERRED}]
90 [RELY | NORELY] [USING INDEX using_index_clause]
91 [ENABLE|DISABLE] [VALIDATE|NOVALIDATE]
92 [EXCEPTIONS INTO [schema.]table]
93
94=cut
95
96use strict;
97use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
98$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
99$DEBUG = 0 unless defined $DEBUG;
100
101use Data::Dumper;
102use Parse::RecDescent;
103use Exporter;
104use base qw(Exporter);
105
106@EXPORT_OK = qw(parse);
107
108# Enable warnings within the Parse::RecDescent module.
109$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
110$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
111$::RD_HINT = 1; # Give out hints to help fix problems.
112
113my $parser;
114
115$GRAMMAR = q!
116
117{ our ( %tables, $table_order ) }
118
119#
120# The "eofile" rule makes the parser fail if any "statement" rule
121# fails. Otherwise, the first successful match by a "statement"
122# won't cause the failure needed to know that the parse, as a whole,
123# failed. -ky
124#
125startrule : statement(s) eofile { \%tables }
126
127eofile : /^\Z/
128
129statement : create
130 | comment
131 | comment_on_table
132 | comment_on_column
133 | <error>
134
135create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
136 {
137 my $table_name = $item{'table_name'};
138 $tables{ $table_name }{'order'} = ++$table_order;
139 $tables{ $table_name }{'table_name'} = $table_name;
140
141 my $i = 1;
142 my @constraints;
143 for my $definition ( @{ $item[4] } ) {
144 if ( $definition->{'type'} eq 'field' ) {
145 my $field_name = $definition->{'name'};
146 $tables{ $table_name }{'fields'}{ $field_name } =
147 { %$definition, order => $i };
148 $i++;
149
150 if ( $definition->{'is_primary_key'} ) {
151 push @{ $tables{ $table_name }{'indices'} }, {
152 type => 'primary_key',
153 fields => [ $field_name ],
154 };
155 }
156
157 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
158 $constraint->{'fields'} = [ $field_name ];
159 push @{ $tables{ $table_name }{'constraints'} },
160 $constraint;
161 }
162 }
163 elsif ( $definition->{'type'} eq 'constraint' ) {
164 $definition->{'type'} = $definition->{'constraint_type'};
165 # group FKs at the field level
166 if ( $definition->{'type'} eq 'foreign_key' ) {
167 for my $fld ( @{ $definition->{'fields'} || [] } ) {
168 push @{
169 $tables{$table_name}{'fields'}{$fld}{'constraints'}
170 }, $definition;
171 }
172 }
173 else {
174 push @{ $tables{ $table_name }{'constraints'} },
175 $definition;
176 }
177 }
178 else {
179 push @{ $tables{ $table_name }{'indices'} }, $definition;
180 }
181 }
182
183 for my $option ( @{ $item[6] } ) {
184 $tables{ $table_name }{'table_options'}{ $option->{'type'} } =
185 $option;
186 }
187
188 1;
189 }
190
191# Create anything else (e.g., domain, function, etc.)
192create : /create/i WORD /[^;]+/ ';'
193
194global_temporary: /global/i /temporary/i
195
196table_name : NAME '.' NAME
197 { $item[3] }
198 | NAME
199 { $item[1] }
200
201create_definition : field
202 | table_constraint
203 | <error>
204
205comment : /^\s*(?:#|-{2}).*\n/
206
207comment_on_table : /comment/i /on/i /table/i table_name /is/i phrase ';'
208 {
209 push @{ $tables{ $item{'table_name'} }{'comments'} }, $item[7];
210 }
211
212comment_on_column : /comment/i /on/i /column/i column_name /is/i phrase ';'
213 {
214 my $table_name = $item[4]->{'table'};
215 my $field_name = $item[4]->{'field'};
216 push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} },
217 $item[7];
218 }
219
220column_name : NAME '.' NAME
221 { $return = { table => $item[1], field => $item[3] } }
222
223phrase : /'.*?'/ { $item[1] }
224
225field : comment(s?) field_name data_type field_meta(s?) comment(s?)
226 {
227 my ( $default, @constraints );
228 for my $meta ( @{ $item[4] } ) {
229 $default = $meta if $meta->{'meta_type'} eq 'default';
230 push @constraints, $meta if $meta->{'meta_type'} eq 'constraint';
231 }
232
233 my $null = ( grep { $_->{'type'} eq 'not_null' } @constraints ) ? 0 : 1;
234
235 $return = {
236 type => 'field',
237 name => $item{'field_name'},
238 data_type => $item{'data_type'}{'type'},
239 size => $item{'data_type'}{'size'},
240 list => $item{'data_type'}{'list'},
241 null => $null,
242 default => $default->{'value'},
243 constraints => [ @constraints ],
244 }
245 }
246 | <error>
247
248field_name : NAME
249
250data_type : ora_data_type parens_value_list(?)
251 {
252 $return = {
253 type => $item[1],
254 size => $item[2][0] || '',
255 }
256 }
257
258column_constraint : constraint_name(?) column_constraint_type
259#constraint_state(s /,/)
260 {
261 my $desc = $item{'column_constraint_type'};
262 my $type = $desc->{'type'};
263 my $fields = $desc->{'fields'} || [];
264 my $expression = $desc->{'expression'} || '';
265
266 $return = {
267 meta_type => 'constraint',
268 name => $item{'constraint_name'}[0] || '',
269 type => $type,
270 expression => $type eq 'check' ? $expression : '',
271 deferreable => $item{'deferrable'},
272 deferred => $item{'deferred'},
273 reference_table => $desc->{'reference_table'},
274 reference_fields => $desc->{'reference_fields'},
275# match_type => $desc->{'match_type'},
276# on_update_do => $desc->{'on_update_do'},
277 }
278 }
279
280constraint_name : /constraint/i NAME { $item[2] }
281
282column_constraint_type : /not null/i { $return = { type => 'not_null' } }
283 |
284 /null/
285 { $return = { type => 'null' } }
286 |
287 /unique/
288 { $return = { type => 'unique' } }
289 |
290 /primary key/i
291 { $return = { type => 'primary_key' } }
292 |
293 /check/i '(' /[^)]+/ ')'
294 { $return = { type => 'check', expression => $item[2] } }
295 |
296 /references/i table_name parens_word_list(?) on_delete_do(?)
297 {
298 $return = {
299 type => 'foreign_key',
300 reference_table => $item[2],
301 reference_fields => $item[3][0],
302# match_type => $item[4][0],
303 on_delete_do => $item[5][0],
304 }
305 }
306
307#constraint_state : deferrable { $return = { type => $item[1] } }
308# | deferred { $return = { type => $item[1] } }
309# | /(no)?rely/ { $return = { type => $item[1] } }
310# | /using/i /index/i using_index_clause
311# { $return = { type => 'using_index', index => $item[3] }
312# | (dis)?enable { $return = { type => $item[1] } }
313# | (no)?validate { $return = { type => $item[1] } }
314# | /exceptions/i /into/i table_name
315# { $return = { type => 'exceptions_into', table => $item[3] } }
316
317deferrable : /not/i /deferrable/i
318 { $return = 'not_deferrable' }
319 | /deferrable/i
320 { $return = 'deferrable' }
321
322deferred : /initially/i /(deferred|immediate)/i { $item[2] }
323
324ora_data_type :
325 /(n?varchar2|varchar)/i { $return = 'varchar' }
326 |
327 /n?char/i { $return = 'character' }
328 |
329 /number/i { $return = 'number' }
330 |
331 /(pls_integer|binary_integer)/i { $return = 'integer' }
332 |
333 /interval\s+day/i { $return = 'interval_day' }
334 |
335 /interval\s+year/i { $return = 'interval_year' }
336 |
337 /long\s+raw/i { $return = 'long_raw' }
338 |
339 /(long|date|timestamp|raw|rowid|urowid|mlslabel|clob|nclob|blob|bfile)/i { $item[1] }
340
341parens_value_list : '(' VALUE(s /,/) ')'
342 { $item[2] }
343
344parens_word_list : '(' WORD(s /,/) ')'
345 { $item[2] }
346
347field_meta : default_val
348 |
349 column_constraint
350
351default_val : /default/i /(?:')?[\w\d.-]*(?:')?/
352 {
353 my $val = $item[2] || '';
354 $val =~ s/'//g;
355 $return = {
356 meta_type => 'default',
357 value => $val,
358 }
359 }
360
361create_table : /create/i global_temporary(?) /table/i
362
363table_option : /[^;]+/
364
365table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
366 {
367 my $desc = $item{'table_constraint_type'};
368 my $type = $desc->{'type'};
369 my $fields = $desc->{'fields'};
370 my $expression = $desc->{'expression'};
371 my @comments = ( @{ $item[1] }, @{ $item[-1] } );
372
373 $return = {
374 name => $item{'constraint_name'}[0] || '',
375 type => 'constraint',
376 constraint_type => $type,
377 fields => $type ne 'check' ? $fields : [],
378 expression => $type eq 'check' ? $expression : '',
379 deferreable => $item{'deferrable'},
380 deferred => $item{'deferred'},
381 reference_table => $desc->{'reference_table'},
382 reference_fields => $desc->{'reference_fields'},
383# match_type => $desc->{'match_type'}[0],
384 on_delete_do => $desc->{'on_delete_do'},
385 on_update_do => $desc->{'on_update_do'},
386 comments => [ @comments ],
387 }
388 }
389
390table_constraint_type : /primary key/i '(' NAME(s /,/) ')'
391 {
392 $return = {
393 type => 'primary_key',
394 fields => $item[3],
395 }
396 }
397 |
398 /unique/i '(' NAME(s /,/) ')'
399 {
400 $return = {
401 type => 'unique',
402 fields => $item[3],
403 }
404 }
405 |
406 /check/ '(' /(.+)/ ')'
407 {
408 $return = {
409 type => 'check',
410 expression => $item[3],
411 }
412 }
413 |
414 /foreign key/i '(' NAME(s /,/) ')' /references/i table_name parens_word_list(?) on_delete_do(?)
415 {
416 $return = {
417 type => 'foreign_key',
418 fields => $item[3],
419 reference_table => $item[6],
420 reference_fields => $item[7][0],
421 match_type => $item[8][0],
422 on_delete_do => $item[9][0],
423 on_update_do => $item[10][0],
424 }
425 }
426
427on_delete_do : /on delete/i WORD(s)
428 { $item[2] }
429
430WORD : /\w+/
431
432NAME : /\w+/ { $item[1] }
433
434VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
435 { $item[1] }
436 | /'.*?'/ # XXX doesn't handle embedded quotes
437 { $item[1] }
438 | /NULL/
439 { 'NULL' }
440
441!;
442
443# -------------------------------------------------------------------
444sub parse {
445 my ( $translator, $data ) = @_;
446 $parser ||= Parse::RecDescent->new($GRAMMAR);
447
448 local $::RD_TRACE = $translator->trace ? 1 : undef;
449 local $DEBUG = $translator->debug;
450
451 unless (defined $parser) {
452 return $translator->error("Error instantiating Parse::RecDescent ".
453 "instance: Bad grammer");
454 }
455
456 my $result = $parser->startrule($data);
457 die "Parse failed.\n" unless defined $result;
458 warn Dumper($result) if $DEBUG;
459 return $result;
460}
461
4621;
463
464=pod
465
466=head1 AUTHOR
467
468Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
469
470=head1 SEE ALSO
471
472perl(1), Parse::RecDescent.
473
474=cut