package SQL::Translator::Parser::SQLServer;
# -------------------------------------------------------------------
-# $Id: SQLServer.pm,v 1.3 2005-06-28 23:37:12 duality72 Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2002-4 SQLFairy Authors
+# Copyright (C) 2002-2009 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
$GRAMMAR = q{
{
- my ( %tables, @table_comments, $table_order );
+ my ( %tables, @table_comments, $table_order, %procedures, $proc_order, %views, $view_order );
}
-startrule : statement(s) eofile { \%tables }
+startrule : statement(s) eofile
+ {
+ return {
+ tables => \%tables,
+ procedures => \%procedures,
+ views => \%views,
+ }
+ }
eofile : /^\Z/
statement : create_table
| create_procedure
+ | create_view
| create_index
| create_constraint
| comment
+ | drop
| use
| setuser
| if
comment_middle : m{([^*]+|\*(?!/))*}
+drop : if_exists(?) /drop/i tbl_drop END_STATEMENT
+
+tbl_drop : /table/i NAME
+
+if_exists : /if exists/i '(' /select/i 'name' /from/i 'sysobjects' /[^\)]+/ ')'
+
#
# Create table.
#
-create_table : /create/i /table/i ident '(' create_def(s /,/) ')' lock(?) on_system(?) ';' GO(?)
+create_table : /create/i /table/i ident '(' create_def(s /,/) ')' lock(?) on_system(?) END_STATEMENT
{
my $table_owner = $item[3]{'owner'};
my $table_name = $item[3]{'name'};
}
}
-create_constraint : /create/i constraint
+create_constraint : /create/i constraint
{
@table_comments = ();
push @{ $tables{ $item[2]{'table'} }{'constraints'} }, $item[2];
}
+create_constraint : /alter/i /table/i ident /add/i foreign_key_constraint END_STATEMENT
+ {
+ push @{ $tables{ $item[3]{name} }{constraints} }, $item[5];
+ }
+
create_index : /create/i index
{
@table_comments = ();
push @{ $tables{ $item[2]{'table'} }{'indices'} }, $item[2];
}
-create_procedure : /create/i /procedure/i procedure_body GO
+create_procedure : /create/i PROCEDURE WORD not_go GO
{
@table_comments = ();
+ my $proc_name = $item[3];
+ my $owner = '';
+ my $sql = "$item[1] $item[2] $proc_name $item[4]";
+
+ $procedures{ $proc_name }{'order'} = ++$proc_order;
+ $procedures{ $proc_name }{'name'} = $proc_name;
+ $procedures{ $proc_name }{'owner'} = $owner;
+ $procedures{ $proc_name }{'sql'} = $sql;
}
-procedure_body : not_go(s)
+create_procedure : /create/i PROCEDURE '[' WORD '].' WORD not_go GO
+ {
+ @table_comments = ();
+ my $proc_name = $item[6];
+ my $owner = $item[4];
+ my $sql = "$item[1] $item[2] [$owner].$proc_name $item[7]";
+
+ $procedures{ $proc_name }{'order'} = ++$proc_order;
+ $procedures{ $proc_name }{'name'} = $proc_name;
+ $procedures{ $proc_name }{'owner'} = $owner;
+ $procedures{ $proc_name }{'sql'} = $sql;
+ }
+
+PROCEDURE : /procedure/i
+ | /function/i
+
+create_view : /create/i /view/i WORD not_go GO
+ {
+ @table_comments = ();
+ my $view_name = $item[3];
+ my $sql = "$item[1] $item[2] $item[3] $item[4]";
+
+ $views{ $view_name }{'order'} = ++$view_order;
+ $views{ $view_name }{'name'} = $view_name;
+ $views{ $view_name }{'sql'} = $sql;
+ }
-not_go : /((?!go).)*/
+not_go : /((?!\bgo\b).)*/is
create_def : constraint
| index
| /null/i
{ $return = 1 }
-default_val : /default/i /(?:')?[^']*(?:')?/
+default_val : /default/i /null/i
+ { $return = 'null' }
+ | /default/i /'[^']*'/
{ $item[2]=~ s/'//g; $return = $item[2] }
auto_inc : /identity/i { 1 }
}
}
+unique_constraint : /constraint/i index_name(?) /unique/i parens_field_list
+ {
+ $return = {
+ supertype => 'constraint',
+ type => 'unique',
+ name => $item[2][0],
+ fields => $item[4],
+ }
+ }
+
unique_constraint : /unique/i clustered(?) INDEX(?) index_name(?) on_table(?) parens_field_list
{
$return = {
on_update : /on update/i reference_option
{ $item[2] }
-reference_option: /cascade/i |
- /no action/i
- { $item[1] }
+reference_option: /cascade/i
+ { $item[1] }
+ | /no action/i
+ { $item[1] }
clustered : /clustered/i
{ $return = 1 }
on_system : /on/i /system/i
{ $return = 1 }
-index : clustered(?) INDEX index_name(?) on_table(?) parens_field_list ';'
+index : clustered(?) INDEX index_name(?) on_table(?) parens_field_list END_STATEMENT
{
$return = {
supertype => 'index',
| WORD
{ $return = { name => $item[1] } }
+END_STATEMENT : ';'
+ | GO
+
GO : /^go/i
NAME : QUOTE(?) /\w+/ QUOTE(?)
my $schema = $translator->schema;
my @tables = sort {
- $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
- } keys %{ $result };
+ $result->{tables}->{ $a }->{'order'} <=> $result->{tables}->{ $b }->{'order'}
+ } keys %{ $result->{tables} };
for my $table_name ( @tables ) {
- my $tdata = $result->{ $table_name };
+ my $tdata = $result->{tables}->{ $table_name };
my $table = $schema->add_table( name => $tdata->{'name'} )
or die "Can't create table '$table_name': ", $schema->error;
) or die $table->error;
}
}
+
+ my @procedures = sort {
+ $result->{procedures}->{ $a }->{'order'} <=> $result->{procedures}->{ $b }->{'order'}
+ } keys %{ $result->{procedures} };
+ for 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} };
+ for my $view_name (keys %{ $result->{views} }) {
+ $schema->add_view(
+ name => $view_name,
+ sql => $result->{views}->{$view_name}->{sql},
+ );
+ }
return 1;
}