package SQL::Translator::Parser::SQLServer;
# -------------------------------------------------------------------
-# $Id: SQLServer.pm,v 1.1 2005-06-27 19:01:31 duality72 Exp $
+# $Id: SQLServer.pm,v 1.6 2007-03-19 17:11:02 duality72 Exp $
# -------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
$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
#
# 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'};
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;
+ }
-not_go : /((?!go).)*/
+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 : /((?!\bgo\b).)*/is
create_def : constraint
| index
size => $item{'data_type'}{'size'},
nullable => $nullable,
default => $qualifiers{'default_val'},
- is_auto_inc => $qualifiers{'auto_inc'},
+ is_auto_inc => $qualifiers{'is_auto_inc'},
# is_primary_key => $item{'primary_key'}[0],
}
}
| /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 }
}
}
-foreign_key_constraint : /constraint/i index_name(?) /foreign/i /key/i parens_field_list /references/i table_name parens_field_list(?) on_delete_do(?) on_update_do(?)
+foreign_key_constraint : /constraint/i index_name(?) /foreign/i /key/i parens_field_list /references/i table_name parens_field_list(?) on_delete(?) on_update(?)
{
$return = {
supertype => 'constraint',
fields => $item[5],
reference_table => $item[7],
reference_fields => $item[8][0],
- on_delete_do => $item[9][0],
- on_update_do => $item[10][0],
+ on_delete => $item[9][0],
+ on_update => $item[10][0],
}
}
}
}
-on_delete_do : /on delete/i reference_option
+on_delete : /on delete/i reference_option
{ $item[2] }
-on_update_do : /on update/i reference_option
+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 }
| 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;
reference_table => $cdata->{'reference_table'},
reference_fields => $cdata->{'reference_fields'},
match_type => $cdata->{'match_type'} || '',
- on_delete => $cdata->{'on_delete_do'},
- on_update => $cdata->{'on_update_do'},
+ on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
+ on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'},
) 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;
}