lib/SQL/Translator/Parser/Oracle.pm

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