Parse new SQL Server stuff

diff --git a/lib/SQL/Translator/Parser/SQLServer.pm b/lib/SQL/Translator/Parser/SQLServer.pm
index 34b4299..edfe0d0 100644 (file)
--- a/lib/SQL/Translator/Parser/SQLServer.pm
+++ b/lib/SQL/Translator/Parser/SQLServer.pm
@@ -84,6 +84,7 @@ statement : create_table
     | create_index
     | create_constraint
     | comment
+    | disable_constraints
     | drop
     | use
     | setuser
@@ -106,6 +107,8 @@ if_command : grant
 
 object_not_null : /object_id/i '(' ident ')' /is not null/i
 
+field_not_null : /where/i field_name /is \s+ not \s+ null/ix
+
 print : /\s*/ /print/i /.*/
 
 else : /else/i /.*/
@@ -145,7 +148,7 @@ comment_middle : m{([^*]+|\*(?!/))*}
 
 drop : if_exists(?) /drop/i tbl_drop END_STATEMENT
 
-tbl_drop : /table/i NAME
+tbl_drop : /table/i ident
 
 if_exists : /if exists/i '(' /select/i 'name' /from/i 'sysobjects' /[^\)]+/ ')'
 
@@ -191,17 +194,29 @@ create_table : /create/i /table/i ident '(' create_def(s /,/) ')' lock(?) on_sys
         }
     }
 
+disable_constraints : if_exists(?) /alter/i /table/i ident /nocheck/i /constraint/i /all/i END_STATEMENT
+
+# this is for the normal case 
+create_constraint : /create/i constraint END_STATEMENT
+    {
+        @table_comments = ();
+        push @{ $tables{ $item[2]{'table'} }{'constraints'} }, $item[2];
+    }
+
+# and this is for the BEGIN/END case
 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 = ();
@@ -299,10 +314,19 @@ constraint : primary_key_constraint
     | unique_constraint
 
 field_name : WORD
+   { $return = $item[1] }
+   | LQUOTE WORD RQUOTE
+   { $return = $item[2] }
 
 index_name : WORD
+   { $return = $item[1] }
+   | LQUOTE WORD RQUOTE
+   { $return = $item[2] }
 
 table_name : WORD
+ { $return = $item[1] }
+ | LQUOTE WORD RQUOTE
+ { $return = $item[2] }
 
 data_type : WORD field_size(?)
     {
@@ -372,7 +396,7 @@ unique_constraint : /constraint/i index_name(?) /unique/i parens_field_list
         }
     }
 
-unique_constraint : /unique/i clustered(?) INDEX(?) index_name(?) on_table(?) parens_field_list
+unique_constraint : /unique/i clustered(?) INDEX(?) index_name(?) on_table(?) parens_field_list field_not_null(?)
     {
         $return = {
             supertype => 'constraint',
@@ -423,8 +447,14 @@ index : clustered(?) INDEX index_name(?) on_table(?) parens_field_list END_STATE
 parens_field_list : '(' field_name(s /,/) ')'
     { $item[2] }
 
-ident : QUOTE(?) WORD '.' WORD QUOTE(?)
+ident : QUOTE WORD '.' WORD QUOTE | LQUOTE WORD '.' WORD RQUOTE
     { $return = { owner => $item[2], name => $item[4] } }
+    | LQUOTE WORD RQUOTE '.' LQUOTE WORD RQUOTE
+    { $return = { owner => $item[2], name => $item[6] } }
+    | LQUOTE WORD RQUOTE
+    { $return = { name  => $item[2] } }
+    | WORD '.' WORD
+    { $return = { owner => $item[1], name => $item[3] } }
     | WORD
     { $return = { name  => $item[1] } }
 
@@ -444,6 +474,10 @@ COMMA : ','
 
 QUOTE : /'/
 
+LQUOTE : '['
+
+RQUOTE : ']'
+
 };
 
 # -------------------------------------------------------------------

diff --git a/lib/SQL/Translator/Producer/SQLServer.pm b/lib/SQL/Translator/Producer/SQLServer.pm
index 0618fc1..009134d 100644 (file)
--- a/lib/SQL/Translator/Producer/SQLServer.pm
+++ b/lib/SQL/Translator/Producer/SQLServer.pm
@@ -78,7 +78,7 @@ my %translate  = (
     #bit       => 'bit',
     #tinyint   => 'smallint',
     #float     => 'double precision',
-    #serial    => 'numeric', 
+    #serial    => 'numeric',
     #boolean   => 'varchar',
     #char      => 'char',
     #long      => 'varchar',
@@ -86,20 +86,20 @@ my %translate  = (
 
 # TODO - This is still the Sybase list!
 my %reserved = map { $_, 1 } qw[
-    ALL ANALYSE ANALYZE AND ANY AS ASC 
+    ALL ANALYSE ANALYZE AND ANY AS ASC
     BETWEEN BINARY BOTH
     CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
-    CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER 
+    CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
     DEFAULT DEFERRABLE DESC DISTINCT DO
     ELSE END EXCEPT
-    FALSE FOR FOREIGN FREEZE FROM FULL 
-    GROUP HAVING 
-    ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL 
-    JOIN LEADING LEFT LIKE LIMIT 
+    FALSE FOR FOREIGN FREEZE FROM FULL
+    GROUP HAVING
+    ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
+    JOIN LEADING LEFT LIKE LIMIT
     NATURAL NEW NOT NOTNULL NULL
     OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
-    PRIMARY PUBLIC REFERENCES RIGHT 
-    SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE 
+    PRIMARY PUBLIC REFERENCES RIGHT
+    SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
     UNION UNIQUE USER USING VERBOSE WHEN WHERE
 ];
 
@@ -259,7 +259,7 @@ sub produce {
               ],
             );
 
-            push @field_defs, $field_def;            
+            push @field_defs, $field_def;
         }
 
         #
@@ -288,7 +288,7 @@ sub produce {
                   undef $_ if $_ eq 'RESTRICT'
                 }
 
-                $c_def = 
+                $c_def =
                     "ALTER TABLE $table_name ADD CONSTRAINT $name FOREIGN KEY".
                     ' (' . join( ', ', @fields ) . ') REFERENCES '.
                     $constraint->reference_table.
@@ -310,14 +310,14 @@ sub produce {
 
 
             if ( $type eq PRIMARY_KEY ) {
-                $name ||= mk_name( $table_name . '_pk' );
-                $c_def = 
+                $name = ($name ? unreserve($name) : mk_name( $table_name . '_pk' ));
+                $c_def =
                     "CONSTRAINT $name PRIMARY KEY ".
                     '(' . join( ', ', @fields ) . ')';
             }
             elsif ( $type eq UNIQUE ) {
                 $name ||= mk_name( $table_name . '_uc' );
-                $c_def = 
+                $c_def =
                     "CONSTRAINT $name UNIQUE " .
                     '(' . join( ', ', @fields ) . ')';
             }
@@ -336,7 +336,7 @@ sub produce {
 
         my $create_statement = "";
         $create_statement .= qq[CREATE TABLE $table_name_ur (\n].
-            join( ",\n", 
+            join( ",\n",
                 map { "  $_" } @field_defs, @constraint_defs
             ).
             "\n);"
@@ -377,7 +377,7 @@ sub produce {
         $output .= "\n\n";
         $output .= "--\n-- Procedure: $name\n--\n\n" unless $no_comments;
         my $text = $_->sql();
-               $text =~ s/\r//g;
+      $text =~ s/\r//g;
         $output .= "$text\nGO\n";
     }
 =cut
@@ -393,7 +393,7 @@ sub mk_name {
     if ( my $prev = $scope->{ $name } ) {
         my $name_orig = $name;
         $name        .= sprintf( "%02d", ++$prev );
-        substr($name, $max_id_length - 3) = "00" 
+        substr($name, $max_id_length - 3) = "00"
             if length( $name ) > $max_id_length;
 
         warn "The name '$name_orig' has been changed to ",
@@ -401,7 +401,7 @@ sub mk_name {
 
         $scope->{ $name_orig }++;
     }
-    $name = substr( $name, 0, $max_id_length ) 
+    $name = substr( $name, 0, $max_id_length )
                         if ((length( $name ) > $max_id_length) && $critical);
     $scope->{ $name }++;
     return $name;
@@ -414,7 +414,7 @@ sub unreserve {
     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 
     # also trap fields that don't begin with a letter
-    return $name if !$reserved{ uc $name } && $name =~ /^[a-z]/i; 
+    return $name if !$reserved{ uc $name } && $name =~ /^[a-z]/i;
 
     my $unreserve = sprintf '%s_', $name;
     return $unreserve.$suffix;