Use precompiled Parse::RecDescent parsers for moar speed
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / Oracle.pm
CommitLineData
17cae8ab 1package SQL::Translator::Parser::Oracle;
2
17cae8ab 3=head1 NAME
4
5SQL::Translator::Parser::Oracle - parser for Oracle
6
7=head1 SYNOPSIS
8
9 use SQL::Translator;
10 use SQL::Translator::Parser::Oracle;
11
12 my $translator = SQL::Translator->new;
13 $translator->parser("SQL::Translator::Parser::Oracle");
14
15=head1 DESCRIPTION
16
17From http://www.ss64.com/ora/table_c.html:
18
19 CREATE [GLOBAL TEMPORARY] TABLE [schema.]table (tbl_defs,...)
20 [ON COMMIT {DELETE|PRESERVE} ROWS]
21 [storage_options | CLUSTER cluster_name (col1, col2,... )
ea93df61 22 | ORGANIZATION {HEAP [storage_options]
17cae8ab 23 | INDEX idx_organized_tbl_clause}]
24 [LOB_storage_clause][varray_clause][nested_storage_clause]
25 partitioning_options
26 [[NO]CACHE] [[NO]MONITORING] [PARALLEL parallel_clause]
27 [ENABLE enable_clause | DISABLE disable_clause]
28 [AS subquery]
29
30tbl_defs:
31 column datatype [DEFAULT expr] [column_constraint(s)]
17cae8ab 32 table_ref_constraint
33
34storage_options:
35 PCTFREE int
36 PCTUSED int
37 INITTRANS int
38 MAXTRANS int
39 STORAGE storage_clause
40 TABLESPACE tablespace
41 [LOGGING|NOLOGGING]
42
43idx_organized_tbl_clause:
44 storage_option(s) [PCTTHRESHOLD int]
45 [COMPRESS int|NOCOMPRESS]
46 [ [INCLUDING column_name] OVERFLOW [storage_option(s)] ]
47
48nested_storage_clause:
49 NESTED TABLE nested_item STORE AS storage_table
50 [RETURN AS {LOCATOR|VALUE} ]
51
52partitioning_options:
53 Partition_clause {ENABLE|DISABLE} ROW MOVEMENT
54
55Column Constraints
56(http://www.ss64.com/ora/clause_constraint_col.html)
57
58 CONSTRAINT constrnt_name {UNIQUE|PRIMARY KEY} constrnt_state
59
60 CONSTRAINT constrnt_name CHECK(condition) constrnt_state
61
62 CONSTRAINT constrnt_name [NOT] NULL constrnt_state
63
64 CONSTRAINT constrnt_name REFERENCES [schema.]table[(column)]
65 [ON DELETE {CASCADE|SET NULL}] constrnt_state
66
ea93df61 67constrnt_state
17cae8ab 68 [[NOT] DEFERRABLE] [INITIALLY {IMMEDIATE|DEFERRED}]
69 [RELY | NORELY] [USING INDEX using_index_clause]
70 [ENABLE|DISABLE] [VALIDATE|NOVALIDATE]
71 [EXCEPTIONS INTO [schema.]table]
72
ea93df61 73Note that probably not all of the above syntax is supported, but the grammar
3b2be65a 74was altered to better handle the syntax created by DDL::Oracle.
75
17cae8ab 76=cut
77
78use strict;
f27f9229 79use warnings;
bdf60588 80
0c04c5a2 81our $VERSION = '1.59';
bdf60588 82
83our $DEBUG;
17cae8ab 84$DEBUG = 0 unless defined $DEBUG;
85
86use Data::Dumper;
bdf60588 87use SQL::Translator::Utils qw/ddl_parser_instance/;
17cae8ab 88
bdf60588 89use base qw(Exporter);
90our @EXPORT_OK = qw(parse);
17cae8ab 91
bdf60588 92our $GRAMMAR = <<'END_OF_GRAMMAR';
17cae8ab 93
dc7506f7 94{ my ( %tables, %indices, %constraints, $table_order, @table_comments, %views, $view_order, %procedures, $proc_order ) }
17cae8ab 95
96#
97# The "eofile" rule makes the parser fail if any "statement" rule
ea93df61 98# fails. Otherwise, the first successful match by a "statement"
17cae8ab 99# won't cause the failure needed to know that the parse, as a whole,
100# failed. -ky
101#
ea93df61 102startrule : statement(s) eofile
103 {
87053733 104 $return = {
6a36a3d8 105 tables => \%tables,
106 indices => \%indices,
107 constraints => \%constraints,
dc7506f7 108 views => \%views,
109 procedures => \%procedures,
87053733 110 };
111 }
17cae8ab 112
113eofile : /^\Z/
114
87053733 115statement : remark
ea93df61 116 | run
87053733 117 | prompt
118 | create
f77a985b 119 | table_comment
067e3cf4 120 | comment_on_table
121 | comment_on_column
122 | alter
123 | drop
124 | <error>
17cae8ab 125
44567b47 126alter : /alter/i WORD /[^;]+/ ';'
067e3cf4 127 { @table_comments = () }
128
129drop : /drop/i TABLE ';'
130
131drop : /drop/i WORD(s) ';'
132 { @table_comments = () }
44567b47 133
87053733 134create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
17cae8ab 135 {
136 my $table_name = $item{'table_name'};
137 $tables{ $table_name }{'order'} = ++$table_order;
138 $tables{ $table_name }{'table_name'} = $table_name;
139
067e3cf4 140 if ( @table_comments ) {
141 $tables{ $table_name }{'comments'} = [ @table_comments ];
142 @table_comments = ();
143 }
144
17cae8ab 145 my $i = 1;
146 my @constraints;
87053733 147 for my $definition ( @{ $item[4] } ) {
17cae8ab 148 if ( $definition->{'type'} eq 'field' ) {
149 my $field_name = $definition->{'name'};
ea93df61 150 $tables{ $table_name }{'fields'}{ $field_name } =
17cae8ab 151 { %$definition, order => $i };
152 $i++;
ea93df61 153
17cae8ab 154 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
155 $constraint->{'fields'} = [ $field_name ];
ea93df61 156 push @{ $tables{ $table_name }{'constraints'} },
17cae8ab 157 $constraint;
158 }
159 }
160 elsif ( $definition->{'type'} eq 'constraint' ) {
161 $definition->{'type'} = $definition->{'constraint_type'};
f77a985b 162 push @{ $tables{ $table_name }{'constraints'} }, $definition;
17cae8ab 163 }
164 else {
165 push @{ $tables{ $table_name }{'indices'} }, $definition;
166 }
167 }
168
87053733 169 for my $option ( @{ $item[6] } ) {
7c4cf567 170 push @{ $tables{ $table_name }{'table_options'} }, $option;
17cae8ab 171 }
172
173 1;
174 }
175
7f6504d3 176create : create_index index_name /on/i table_name index_expr table_option(?) ';'
b85a95ec 177 {
3b668c81 178 my $table_name = $item[4];
179 if ( $item[1] ) {
6a36a3d8 180 push @{ $constraints{ $table_name } }, {
3b668c81 181 name => $item[2],
6a36a3d8 182 type => 'unique',
3b668c81 183 fields => $item[5],
6a36a3d8 184 };
185 }
186 else {
187 push @{ $indices{ $table_name } }, {
3b668c81 188 name => $item[2],
6a36a3d8 189 type => 'normal',
3b668c81 190 fields => $item[5],
6a36a3d8 191 };
192 }
b85a95ec 193 }
194
7f6504d3 195index_expr: parens_word_list
ea93df61 196 { $item[1] }
197 | '(' WORD parens_word_list ')'
198 {
199 my $arg_list = join(",", @{$item[3]});
200 $return = "$item[2]($arg_list)";
201 }
7f6504d3 202
dc7506f7 203create : /create/i /or replace/i /procedure/i table_name not_end m#^/$#im
ea93df61 204 {
205 @table_comments = ();
dc7506f7 206 my $proc_name = $item[4];
207 # Hack to strip owner from procedure name
208 $proc_name =~ s#.*\.##;
209 my $owner = '';
210 my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5]";
ea93df61 211
dc7506f7 212 $procedures{ $proc_name }{'order'} = ++$proc_order;
213 $procedures{ $proc_name }{'name'} = $proc_name;
214 $procedures{ $proc_name }{'owner'} = $owner;
215 $procedures{ $proc_name }{'sql'} = $sql;
ea93df61 216 }
dc7506f7 217
218not_end: m#.*?(?=^/$)#ism
219
220create : /create/i /or replace/i /force/i /view/i table_name not_delimiter ';'
ea93df61 221 {
222 @table_comments = ();
dc7506f7 223 my $view_name = $item[5];
224 # Hack to strip owner from view name
225 $view_name =~ s#.*\.##;
226 my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5] $item[6] $item[7]";
ea93df61 227
dc7506f7 228 $views{ $view_name }{'order'} = ++$view_order;
229 $views{ $view_name }{'name'} = $view_name;
230 $views{ $view_name }{'sql'} = $sql;
ea93df61 231 }
dc7506f7 232
233not_delimiter: /.*?(?=;)/is
234
17cae8ab 235# Create anything else (e.g., domain, function, etc.)
3b668c81 236create : ...!create_table ...!create_index /create/i WORD /[^;]+/ ';'
067e3cf4 237 { @table_comments = () }
17cae8ab 238
3b668c81 239create_index : /create/i UNIQUE(?) /index/i
ea93df61 240 { $return = @{$item[2]} }
3b668c81 241
242index_name : NAME '.' NAME
243 { $item[3] }
ea93df61 244 | NAME
3b668c81 245 { $item[1] }
246
17cae8ab 247global_temporary: /global/i /temporary/i
248
249table_name : NAME '.' NAME
250 { $item[3] }
ea93df61 251 | NAME
17cae8ab 252 { $item[1] }
253
2e0b9763 254create_definition : table_constraint
255 | field
17cae8ab 256 | <error>
257
f77a985b 258table_comment : comment
259 {
260 my $comment = $item[1];
261 $return = $comment;
262 push @table_comments, $comment;
263 }
264
17cae8ab 265comment : /^\s*(?:#|-{2}).*\n/
067e3cf4 266 {
39129b47 267 my $comment = $item[1];
268 $comment =~ s/^\s*(#|-{2})\s*//;
269 $comment =~ s/\s*$//;
270 $return = $comment;
f77a985b 271 }
272
ea93df61 273comment : /\/\*/ /[^\*]+/ /\*\//
f77a985b 274 {
275 my $comment = $item[2];
276 $comment =~ s/^\s*|\s*$//g;
277 $return = $comment;
067e3cf4 278 }
17cae8ab 279
87053733 280remark : /^REM\s+.*\n/
281
3b668c81 282run : /^(RUN|\/)\s+.*\n/
283
87053733 284prompt : /prompt/i /(table|index|sequence|trigger)/i ';'
285
286prompt : /prompt\s+create\s+.*\n/i
287
947dfd86 288comment_on_table : /comment/i /on/i /table/i table_name /is/i comment_phrase ';'
17cae8ab 289 {
947dfd86 290 push @{ $tables{ $item{'table_name'} }{'comments'} }, $item{'comment_phrase'};
17cae8ab 291 }
292
947dfd86 293comment_on_column : /comment/i /on/i /column/i column_name /is/i comment_phrase ';'
17cae8ab 294 {
295 my $table_name = $item[4]->{'table'};
296 my $field_name = $item[4]->{'field'};
ea93df61 297 push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} },
947dfd86 298 $item{'comment_phrase'};
17cae8ab 299 }
300
301column_name : NAME '.' NAME
302 { $return = { table => $item[1], field => $item[3] } }
303
ea93df61 304comment_phrase : /'.*?'/
305 {
947dfd86 306 my $val = $item[1];
307 $val =~ s/^'|'$//g;
308 $return = $val;
309 }
17cae8ab 310
311field : comment(s?) field_name data_type field_meta(s?) comment(s?)
312 {
947dfd86 313 my ( $is_pk, $default, @constraints );
314 my $null = 1;
17cae8ab 315 for my $meta ( @{ $item[4] } ) {
947dfd86 316 if ( $meta->{'type'} eq 'default' ) {
317 $default = $meta;
318 next;
319 }
320 elsif ( $meta->{'type'} eq 'not_null' ) {
321 $null = 0;
322 next;
323 }
324 elsif ( $meta->{'type'} eq 'primary_key' ) {
325 $is_pk = 1;
326 }
327
328 push @constraints, $meta if $meta->{'supertype'} eq 'constraint';
17cae8ab 329 }
330
947dfd86 331 my @comments = ( @{ $item[1] }, @{ $item[5] } );
17cae8ab 332
ea93df61 333 $return = {
17cae8ab 334 type => 'field',
ea93df61 335 name => $item{'field_name'},
17cae8ab 336 data_type => $item{'data_type'}{'type'},
337 size => $item{'data_type'}{'size'},
17cae8ab 338 null => $null,
339 default => $default->{'value'},
947dfd86 340 is_primary_key => $is_pk,
17cae8ab 341 constraints => [ @constraints ],
947dfd86 342 comments => [ @comments ],
ea93df61 343 }
17cae8ab 344 }
345 | <error>
346
347field_name : NAME
348
7f6504d3 349data_type : ora_data_type data_size(?)
ea93df61 350 {
351 $return = {
17cae8ab 352 type => $item[1],
353 size => $item[2][0] || '',
ea93df61 354 }
17cae8ab 355 }
ea93df61 356
7f6504d3 357data_size : '(' VALUE(s /,/) data_size_modifier(?) ')'
ea93df61 358 { $item[2] }
7f6504d3 359
360data_size_modifier: /byte/i
ea93df61 361 | /char/i
17cae8ab 362
3b668c81 363column_constraint : constraint_name(?) column_constraint_type constraint_state(s?)
17cae8ab 364 {
365 my $desc = $item{'column_constraint_type'};
366 my $type = $desc->{'type'};
367 my $fields = $desc->{'fields'} || [];
368 my $expression = $desc->{'expression'} || '';
369
370 $return = {
947dfd86 371 supertype => 'constraint',
372 name => $item{'constraint_name(?)'}[0] || '',
17cae8ab 373 type => $type,
374 expression => $type eq 'check' ? $expression : '',
2e0b9763 375 deferrable => $desc->{'deferrable'},
376 deferred => $desc->{'deferred'},
17cae8ab 377 reference_table => $desc->{'reference_table'},
378 reference_fields => $desc->{'reference_fields'},
379# match_type => $desc->{'match_type'},
100684f3 380# on_update => $desc->{'on_update'},
ea93df61 381 }
17cae8ab 382 }
383
384constraint_name : /constraint/i NAME { $item[2] }
385
c72b8f32 386column_constraint_type : /not\s+null/i { $return = { type => 'not_null' } }
3294d624 387 | /unique/i
17cae8ab 388 { $return = { type => 'unique' } }
ea93df61 389 | /primary\s+key/i
17cae8ab 390 { $return = { type => 'primary_key' } }
2e0b9763 391 | /check/i check_expression
ea93df61 392 {
393 $return = {
394 type => 'check',
395 expression => $item[2],
2e0b9763 396 };
397 }
ea93df61 398 | /references/i table_name parens_word_list(?) on_delete(?)
17cae8ab 399 {
400 $return = {
401 type => 'foreign_key',
402 reference_table => $item[2],
403 reference_fields => $item[3][0],
404# match_type => $item[4][0],
100684f3 405 on_delete => $item[5][0],
17cae8ab 406 }
407 }
408
2e0b9763 409LPAREN : '('
410
411RPAREN : ')'
412
413check_condition_text : /.+\s+in\s+\([^)]+\)/i
ea93df61 414 | /[^)]+/
2e0b9763 415
ea93df61 416check_expression : LPAREN check_condition_text RPAREN
417 { $return = join( ' ', map { $_ || () }
418 $item[1], $item[2], $item[3], $item[4][0] )
2e0b9763 419 }
420
3b668c81 421constraint_state : deferrable { $return = { type => $item[1] } }
422 | deferred { $return = { type => $item[1] } }
423 | /(no)?rely/i { $return = { type => $item[1] } }
ea93df61 424# | /using/i /index/i using_index_clause
3b668c81 425# { $return = { type => 'using_index', index => $item[3] } }
426 | /(dis|en)able/i { $return = { type => $item[1] } }
427 | /(no)?validate/i { $return = { type => $item[1] } }
ea93df61 428 | /exceptions/i /into/i table_name
3b668c81 429 { $return = { type => 'exceptions_into', table => $item[3] } }
17cae8ab 430
ea93df61 431deferrable : /not/i /deferrable/i
17cae8ab 432 { $return = 'not_deferrable' }
ea93df61 433 | /deferrable/i
17cae8ab 434 { $return = 'deferrable' }
435
436deferred : /initially/i /(deferred|immediate)/i { $item[2] }
437
438ora_data_type :
947dfd86 439 /(n?varchar2|varchar)/i { $return = 'varchar2' }
17cae8ab 440 |
441 /n?char/i { $return = 'character' }
442 |
ea93df61 443 /n?dec/i { $return = 'decimal' }
444 |
17cae8ab 445 /number/i { $return = 'number' }
446 |
87053733 447 /integer/i { $return = 'integer' }
448 |
17cae8ab 449 /(pls_integer|binary_integer)/i { $return = 'integer' }
450 |
3b668c81 451 /interval\s+day/i { $return = 'interval day' }
17cae8ab 452 |
3b668c81 453 /interval\s+year/i { $return = 'interval year' }
17cae8ab 454 |
3b668c81 455 /long\s+raw/i { $return = 'long raw' }
17cae8ab 456 |
60979a72 457 /(long|date|timestamp|raw|rowid|urowid|mlslabel|clob|nclob|blob|bfile|float|double)/i { $item[1] }
17cae8ab 458
459parens_value_list : '(' VALUE(s /,/) ')'
460 { $item[2] }
461
462parens_word_list : '(' WORD(s /,/) ')'
463 { $item[2] }
464
465field_meta : default_val
947dfd86 466 | column_constraint
17cae8ab 467
ea93df61 468default_val : /default/i /(?:')?[\w\d.-]*(?:')?/
469 {
b85a95ec 470 my $val = $item[2];
ea93df61 471 $val =~ s/'//g if defined $val;
17cae8ab 472 $return = {
947dfd86 473 supertype => 'constraint',
474 type => 'default',
17cae8ab 475 value => $val,
476 }
477 }
3294d624 478 | /null/i
479 {
480 $return = {
481 supertype => 'constraint',
482 type => 'default',
483 value => 'NULL',
484 }
485 }
17cae8ab 486
487create_table : /create/i global_temporary(?) /table/i
488
7c4cf567 489table_option : /organization/i WORD
490 {
491 $return = { 'ORGANIZATION' => $item[2] }
492 }
493
494table_option : /nomonitoring/i
495 {
496 $return = { 'NOMONITORING' => undef }
497 }
498
499table_option : /parallel/i '(' key_value(s) ')'
500 {
501 $return = { 'PARALLEL' => $item[3] }
502 }
503
504key_value : WORD VALUE
505 {
506 $return = { $item[1], $item[2] }
507 }
508
17cae8ab 509table_option : /[^;]+/
510
3b668c81 511table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) constraint_state(s?) comment(s?)
17cae8ab 512 {
513 my $desc = $item{'table_constraint_type'};
514 my $type = $desc->{'type'};
515 my $fields = $desc->{'fields'};
516 my $expression = $desc->{'expression'};
517 my @comments = ( @{ $item[1] }, @{ $item[-1] } );
518
519 $return = {
947dfd86 520 name => $item{'constraint_name(?)'}[0] || '',
17cae8ab 521 type => 'constraint',
522 constraint_type => $type,
523 fields => $type ne 'check' ? $fields : [],
524 expression => $type eq 'check' ? $expression : '',
40c5e2f4 525 deferrable => $item{'deferrable(?)'},
947dfd86 526 deferred => $item{'deferred(?)'},
17cae8ab 527 reference_table => $desc->{'reference_table'},
528 reference_fields => $desc->{'reference_fields'},
529# match_type => $desc->{'match_type'}[0],
100684f3 530 on_delete => $desc->{'on_delete'} || $desc->{'on_delete_do'},
531 on_update => $desc->{'on_update'} || $desc->{'on_update_do'},
17cae8ab 532 comments => [ @comments ],
ea93df61 533 }
17cae8ab 534 }
535
3b668c81 536table_constraint_type : /primary key/i '(' NAME(s /,/) ')'
ea93df61 537 {
17cae8ab 538 $return = {
539 type => 'primary_key',
540 fields => $item[3],
541 }
542 }
543 |
ea93df61 544 /unique/i '(' NAME(s /,/) ')'
545 {
17cae8ab 546 $return = {
547 type => 'unique',
548 fields => $item[3],
549 }
550 }
551 |
2e0b9763 552 /check/i check_expression /^(en|dis)able/i
17cae8ab 553 {
554 $return = {
555 type => 'check',
2e0b9763 556 expression => join(' ', $item[2], $item[3]),
17cae8ab 557 }
558 }
559 |
100684f3 560 /foreign key/i '(' NAME(s /,/) ')' /references/i table_name parens_word_list(?) on_delete(?)
17cae8ab 561 {
562 $return = {
563 type => 'foreign_key',
564 fields => $item[3],
565 reference_table => $item[6],
566 reference_fields => $item[7][0],
188a97b5 567# match_type => $item[8][0],
568 on_delete => $item[8][0],
569# on_update => $item[9][0],
17cae8ab 570 }
571 }
572
100684f3 573on_delete : /on delete/i WORD(s)
188a97b5 574 { join(' ', @{$item[2]}) }
17cae8ab 575
6a36a3d8 576UNIQUE : /unique/i { $return = 1 }
577
17cae8ab 578WORD : /\w+/
579
580NAME : /\w+/ { $item[1] }
581
067e3cf4 582TABLE : /table/i
583
17cae8ab 584VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
585 { $item[1] }
586 | /'.*?'/ # XXX doesn't handle embedded quotes
587 { $item[1] }
588 | /NULL/
589 { 'NULL' }
590
bdf60588 591END_OF_GRAMMAR
17cae8ab 592
17cae8ab 593sub parse {
594 my ( $translator, $data ) = @_;
17cae8ab 595
bdf60588 596 # Enable warnings within the Parse::RecDescent module.
597 local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
598 local $::RD_WARN = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
599 local $::RD_HINT = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.
17cae8ab 600
bdf60588 601 local $::RD_TRACE = $translator->trace ? 1 : undef;
602 local $DEBUG = $translator->debug;
603
604 my $parser = ddl_parser_instance('Oracle');
17cae8ab 605
87053733 606 my $result = $parser->startrule( $data );
17cae8ab 607 die "Parse failed.\n" unless defined $result;
c72b8f32 608 if ( $DEBUG ) {
609 warn "Parser results =\n", Dumper($result), "\n";
610 }
947dfd86 611
6a36a3d8 612 my $schema = $translator->schema;
613 my $indices = $result->{'indices'};
614 my $constraints = $result->{'constraints'};
ea93df61 615 my @tables = sort {
616 $result->{'tables'}{ $a }{'order'}
617 <=>
87053733 618 $result->{'tables'}{ $b }{'order'}
619 } keys %{ $result->{'tables'} };
947dfd86 620
621 for my $table_name ( @tables ) {
87053733 622 my $tdata = $result->{'tables'}{ $table_name };
623 next unless $tdata->{'table_name'};
ea93df61 624 my $table = $schema->add_table(
947dfd86 625 name => $tdata->{'table_name'},
44567b47 626 comments => $tdata->{'comments'},
947dfd86 627 ) or die $schema->error;
628
7c4cf567 629 $table->options( $tdata->{'table_options'} );
630
ea93df61 631 my @fields = sort {
632 $tdata->{'fields'}->{$a}->{'order'}
947dfd86 633 <=>
634 $tdata->{'fields'}->{$b}->{'order'}
635 } keys %{ $tdata->{'fields'} };
636
637 for my $fname ( @fields ) {
638 my $fdata = $tdata->{'fields'}{ $fname };
639 my $field = $table->add_field(
640 name => $fdata->{'name'},
641 data_type => $fdata->{'data_type'},
642 size => $fdata->{'size'},
643 default_value => $fdata->{'default'},
644 is_auto_increment => $fdata->{'is_auto_inc'},
645 is_nullable => $fdata->{'null'},
44567b47 646 comments => $fdata->{'comments'},
947dfd86 647 ) or die $table->error;
947dfd86 648 }
649
87053733 650 push @{ $tdata->{'indices'} }, @{ $indices->{ $table_name } || [] };
ea93df61 651 push @{ $tdata->{'constraints'} },
6a36a3d8 652 @{ $constraints->{ $table_name } || [] };
87053733 653
947dfd86 654 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
655 my $index = $table->add_index(
656 name => $idata->{'name'},
657 type => uc $idata->{'type'},
658 fields => $idata->{'fields'},
659 ) or die $table->error;
660 }
661
662 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
663 my $constraint = $table->add_constraint(
664 name => $cdata->{'name'},
665 type => $cdata->{'type'},
666 fields => $cdata->{'fields'},
2e0b9763 667 expression => $cdata->{'expression'},
947dfd86 668 reference_table => $cdata->{'reference_table'},
669 reference_fields => $cdata->{'reference_fields'},
670 match_type => $cdata->{'match_type'} || '',
ea93df61 671 on_delete => $cdata->{'on_delete'}
2e0b9763 672 || $cdata->{'on_delete_do'},
ea93df61 673 on_update => $cdata->{'on_update'}
2e0b9763 674 || $cdata->{'on_update_do'},
947dfd86 675 ) or die $table->error;
676 }
677 }
ea93df61 678
679 my @procedures = sort {
dc7506f7 680 $result->{procedures}->{ $a }->{'order'} <=> $result->{procedures}->{ $b }->{'order'}
681 } keys %{ $result->{procedures} };
682 foreach my $proc_name (@procedures) {
ea93df61 683 $schema->add_procedure(
684 name => $proc_name,
685 owner => $result->{procedures}->{$proc_name}->{owner},
686 sql => $result->{procedures}->{$proc_name}->{sql},
687 );
dc7506f7 688 }
689
ea93df61 690 my @views = sort {
dc7506f7 691 $result->{views}->{ $a }->{'order'} <=> $result->{views}->{ $b }->{'order'}
692 } keys %{ $result->{views} };
693 foreach my $view_name (keys %{ $result->{views} }) {
ea93df61 694 $schema->add_view(
695 name => $view_name,
696 sql => $result->{views}->{$view_name}->{sql},
697 );
dc7506f7 698 }
947dfd86 699
f62bd16c 700 return 1;
17cae8ab 701}
702
7031;
704
947dfd86 705# -------------------------------------------------------------------
706# Something there is that doesn't love a wall.
707# Robert Frost
708# -------------------------------------------------------------------
709
17cae8ab 710=pod
711
712=head1 AUTHOR
713
2e0b9763 714Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
17cae8ab 715
716=head1 SEE ALSO
717
3b2be65a 718SQL::Translator, Parse::RecDescent, DDL::Oracle.
17cae8ab 719
720=cut