From: Chris Hilton Date: Mon, 19 Mar 2007 22:32:31 +0000 (+0000) Subject: Added cursory parsing of views and procedures X-Git-Tag: v0.11008~365 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dc7506f736ac0516121d3e5828cdf736b96e209c;p=dbsrgits%2FSQL-Translator.git Added cursory parsing of views and procedures --- diff --git a/lib/SQL/Translator/Parser/Oracle.pm b/lib/SQL/Translator/Parser/Oracle.pm index 589ca99..374e186 100644 --- a/lib/SQL/Translator/Parser/Oracle.pm +++ b/lib/SQL/Translator/Parser/Oracle.pm @@ -1,7 +1,7 @@ package SQL::Translator::Parser::Oracle; # ------------------------------------------------------------------- -# $Id: Oracle.pm,v 1.28 2007-03-14 20:20:09 duality72 Exp $ +# $Id: Oracle.pm,v 1.29 2007-03-19 22:32:31 duality72 Exp $ # ------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -97,7 +97,7 @@ was altered to better handle the syntax created by DDL::Oracle. use strict; use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.28 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -114,7 +114,7 @@ $::RD_HINT = 1; # Give out hints to help fix problems. $GRAMMAR = q` -{ my ( %tables, %indices, %constraints, $table_order, @table_comments ) } +{ my ( %tables, %indices, %constraints, $table_order, @table_comments, %views, $view_order, %procedures, $proc_order ) } # # The "eofile" rule makes the parser fail if any "statement" rule @@ -128,6 +128,8 @@ startrule : statement(s) eofile tables => \%tables, indices => \%indices, constraints => \%constraints, + views => \%views, + procedures => \%procedures, }; } @@ -221,6 +223,38 @@ index_expr: parens_word_list $return = "$item[2]($arg_list)"; } +create : /create/i /or replace/i /procedure/i table_name not_end m#^/$#im + { + @table_comments = (); + my $proc_name = $item[4]; + # Hack to strip owner from procedure name + $proc_name =~ s#.*\.##; + my $owner = ''; + my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5]"; + + $procedures{ $proc_name }{'order'} = ++$proc_order; + $procedures{ $proc_name }{'name'} = $proc_name; + $procedures{ $proc_name }{'owner'} = $owner; + $procedures{ $proc_name }{'sql'} = $sql; + } + +not_end: m#.*?(?=^/$)#ism + +create : /create/i /or replace/i /force/i /view/i table_name not_delimiter ';' + { + @table_comments = (); + my $view_name = $item[5]; + # Hack to strip owner from view name + $view_name =~ s#.*\.##; + my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5] $item[6] $item[7]"; + + $views{ $view_name }{'order'} = ++$view_order; + $views{ $view_name }{'name'} = $view_name; + $views{ $view_name }{'sql'} = $sql; + } + +not_delimiter: /.*?(?=;)/is + # Create anything else (e.g., domain, function, etc.) create : ...!create_table ...!create_index /create/i WORD /[^;]+/ ';' { @table_comments = () } @@ -644,6 +678,27 @@ sub parse { ) or die $table->error; } } + + my @procedures = sort { + $result->{procedures}->{ $a }->{'order'} <=> $result->{procedures}->{ $b }->{'order'} + } keys %{ $result->{procedures} }; + foreach my $proc_name (@procedures) { + $schema->add_procedure( + name => $proc_name, + owner => $result->{procedures}->{$proc_name}->{owner}, + sql => $result->{procedures}->{$proc_name}->{sql}, + ); + } + + my @views = sort { + $result->{views}->{ $a }->{'order'} <=> $result->{views}->{ $b }->{'order'} + } keys %{ $result->{views} }; + foreach my $view_name (keys %{ $result->{views} }) { + $schema->add_view( + name => $view_name, + sql => $result->{views}->{$view_name}->{sql}, + ); + } return 1; } diff --git a/t/15oracle-parser.t b/t/15oracle-parser.t index 4a90eb7..adce322 100644 --- a/t/15oracle-parser.t +++ b/t/15oracle-parser.t @@ -7,7 +7,7 @@ use SQL::Translator; use SQL::Translator::Schema::Constants; use Test::SQL::Translator qw(maybe_plan); -maybe_plan(89, 'SQL::Translator::Parser::Oracle'); +maybe_plan(97, 'SQL::Translator::Parser::Oracle'); SQL::Translator::Parser::Oracle->import('parse'); my $t = SQL::Translator->new( trace => 0 ); @@ -66,6 +66,46 @@ my $sql = q[ UNIQUE( qtl_trait_id, trait_synonym ), FOREIGN KEY ( qtl_trait_id ) REFERENCES qtl_trait ON DELETE SET NULL ); + +-- View and procedure testing + CREATE OR REPLACE PROCEDURE CMDOMAIN_LATEST.P_24_HOUR_EVENT_SUMMARY + IS + ldate varchar2(10); + user_added INT; + user_deleted INT; + workingsets_created INT; + change_executed INT; + change_detected INT; + reports_run INT; + backup_complete INT; + backup_failed INT; + devices_in_inventory INT; + + + BEGIN + + select CAST(TO_CHAR(sysdate,'MM/DD/YYYY') AS varchar2(10)) INTO ldate from dual; + END; +/ + + CREATE OR REPLACE FORCE VIEW CMDOMAIN_MIG.VS_ASSET (ASSET_ID, FQ_NAME, FOLDER_NAME, ASSET_NAME, ANNOTATION, ASSET_TYPE, FOREIGN_ASSET_ID, FOREIGN_ASSET_ID2, DATE_CREATED, DATE_MODIFIED, CONTAINER_ID, CREATOR_ID, MODIFIER_ID, USER_ACCESS) AS + SELECT + a.asset_id, a.fq_name, + ap_extract_folder(a.fq_name) AS folder_name, + ap_extract_asset(a.fq_name) AS asset_name, + a.annotation, + a.asset_type, + a.foreign_asset_id, + a.foreign_asset_id2, + a.dateCreated AS date_created, + a.dateModified AS date_modified, + a.container_id, + a.creator_id, + a.modifier_id, + m.user_id AS user_access + from asset a + JOIN M_ACCESS_CONTROL m on a.acl_id = m.acl_id; + ]; $| = 1; @@ -253,3 +293,17 @@ is( join(',', $t4_c3->reference_fields), 'qtl_trait_id', 'Reference fields = "qtl_trait_id"' ); is( $t4_c3->on_delete, 'SET NULL', 'on_delete = "SET NULL"' ); + +my @views = $schema->get_views; +is( scalar @views, 1, 'Right number of views (1)' ); +my $view1 = shift @views; +is( $view1->name, 'VS_ASSET', 'Found "VS_ASSET" view' ); +like($view1->sql, qr/VS_ASSET/, "Detected view VS_ASSET"); +unlike($view1->sql, qr/CMDOMAIN_MIG/, "Did not detect CMDOMAIN_MIG"); + +my @procs = $schema->get_procedures; +is( scalar @procs, 1, 'Right number of procedures (1)' ); +my $proc1 = shift @procs; +is( $proc1->name, 'P_24_HOUR_EVENT_SUMMARY', 'Found "P_24_HOUR_EVENT_SUMMARY" procedure' ); +like($proc1->sql, qr/P_24_HOUR_EVENT_SUMMARY/, "Detected procedure P_24_HOUR_EVENT_SUMMARY"); +unlike($proc1->sql, qr/CMDOMAIN_MIG/, "Did not detect CMDOMAIN_MIG");