X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FSQLServer.pm;h=cb93c6480434ec97d96b85441135dffada7f0a35;hb=e6fcfabf1d69112e7ce8fcfe2fa6d798f1132823;hp=ba644c6892636023abfecb890a51552d28488d01;hpb=0a6e5a568932a67e278066948cf10e43e7aabf3e;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/SQLServer.pm b/lib/SQL/Translator/Producer/SQLServer.pm index ba644c6..cb93c64 100644 --- a/lib/SQL/Translator/Producer/SQLServer.pm +++ b/lib/SQL/Translator/Producer/SQLServer.pm @@ -1,23 +1,5 @@ package SQL::Translator::Producer::SQLServer; -# ------------------------------------------------------------------- -# 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 -# published by the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -# 02111-1307 USA -# ------------------------------------------------------------------- - =head1 NAME SQL::Translator::Producer::SQLServer - MS SQLServer producer for SQL::Translator @@ -53,16 +35,19 @@ List of values for an enum field. =cut use strict; -use vars qw[ $DEBUG $WARN $VERSION ]; -$VERSION = '1.59'; +use warnings; +our ( $DEBUG, $WARN ); +our $VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use Data::Dumper; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(debug header_comment); -use SQL::Translator::Shim; +use SQL::Translator::Generator::Utils; +use SQL::Translator::Generator::DDL::SQLServer; -my $shim = SQL::Translator::Shim->new( quote_chars => ['[', ']'] ); +my $util = SQL::Translator::Generator::Utils->new( quote_chars => ['[', ']'] ); +my $future = SQL::Translator::Generator::DDL::SQLServer->new(); my %translate = ( date => 'datetime', @@ -101,7 +86,6 @@ TODO =cut -# ------------------------------------------------------------------- sub produce { my $translator = shift; $DEBUG = $translator->debug; @@ -115,22 +99,21 @@ sub produce { my $output; $output .= header_comment."\n" unless ($no_comments); - # Generate the DROP statements. We do this in one block here as if we - # have fkeys we need to drop in the correct order otherwise they will fail - # due to the dependancies the fkeys setup. (There is no way to turn off - # fkey checking while we sort the schema like MySQL's set - # foreign_key_checks=0) - # We assume the tables are in the correct order to set them up as you need - # to have created a table to fkey to it. So the reverse order should drop - # them properly, fingers crossed... + # Generate the DROP statements. if ($add_drop_table) { + my @tables = sort { $b->order <=> $a->order } $schema->get_tables; + $output .= "--\n-- Turn off constraints\n--\n\n" unless $no_comments; + foreach my $table (@tables) { + my $name = $table->name; + my $q_name = unreserve($name); + $output .= "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') ALTER TABLE $q_name NOCHECK CONSTRAINT all;\n" + } + $output .= "\n"; $output .= "--\n-- Drop tables\n--\n\n" unless $no_comments; - foreach my $table ( - sort { $b->order <=> $a->order } $schema->get_tables - ) { + foreach my $table (@tables) { my $name = $table->name; my $q_name = unreserve($name); - $output .= qq{IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') DROP TABLE $q_name;\n\n} + $output .= "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') DROP TABLE $q_name;\n" } } @@ -155,18 +138,11 @@ sub produce { my %field_name_scope; for my $field ( $table->get_fields ) { my $field_name = $field->name; - my $field_name_ur = unreserve( $field_name ); - my $field_def = qq["$field_name_ur"]; - $field_def =~ s/\"//g; - if ( $field_def =~ /identity/ ){ - $field_def =~ s/identity/pidentity/; - } # # Datatype # my $data_type = lc $field->data_type; - my $orig_data_type = $data_type; my %extra = $field->extra; my $list = $extra{'list'} || []; # \todo deal with embedded quotes @@ -178,73 +154,8 @@ sub produce { "CONSTRAINT $check_name CHECK ($field_name IN ($commalist))"; $data_type .= 'character varying'; } - elsif ( $data_type eq 'set' ) { - $data_type .= 'character varying'; - } - elsif ( grep { $data_type eq $_ } qw/bytea blob clob/ ) { - $data_type = 'varbinary'; - } - else { - if ( defined $translate{ $data_type } ) { - $data_type = $translate{ $data_type }; - } - else { - warn "Unknown datatype: $data_type ", - "($table_name.$field_name)\n" if $WARN; - } - } - my $size = $field->size; - if ( grep $_ eq $data_type, @no_size) { - # SQLServer doesn't seem to like sizes on some datatypes - $size = undef; - } - elsif ( !$size ) { - if ( $data_type =~ /numeric/ ) { - $size = '9,0'; - } - elsif ( $orig_data_type eq 'text' ) { - #interpret text fields as long varchars - $size = '255'; - } - elsif ( - $data_type eq 'varchar' && - $orig_data_type eq 'boolean' - ) { - $size = '6'; - } - elsif ( $data_type eq 'varchar' ) { - $size = '255'; - } - } - - $field_def .= " $data_type"; - $field_def .= "($size)" if $size; - - $field_def .= ' IDENTITY' if $field->is_auto_increment; - - # - # Not null constraint - # - unless ( $field->is_nullable ) { - $field_def .= ' NOT NULL'; - } - else { - $field_def .= ' NULL' if $data_type ne 'bit'; - } - - # - # Default value - # - SQL::Translator::Producer->_apply_default_value( - $field, - \$field_def, - [ - 'NULL' => \'NULL', - ], - ); - - push @field_defs, $field_def; + push @field_defs, $future->field($field); } # @@ -296,16 +207,22 @@ sub produce { if ( $type eq PRIMARY_KEY ) { - $name = ($name ? unreserve($name) : mk_name( $table_name . '_pk' )); - $c_def = - "CONSTRAINT $name PRIMARY KEY ". - '(' . join( ', ', @fields ) . ')'; + $c_def = $future->primary_key_constraint($constraint) } elsif ( $type eq UNIQUE ) { $name = $name_ur || mk_name( $table_name . '_uc' ); - $c_def = - "CONSTRAINT $name UNIQUE " . - '(' . join( ', ', @fields ) . ')'; + my @nullable = grep { $_->is_nullable } $constraint->fields; + if (!@nullable) { + $c_def = + "CONSTRAINT $name UNIQUE " . + '(' . join( ', ', @fields ) . ')'; + } else { + push @index_defs, + "CREATE UNIQUE NONCLUSTERED INDEX $name_ur ON $table_name_ur (" . + join( ', ', @fields ) . ')' . + ' WHERE ' . join( ' AND ', map unreserve($_->name) . ' IS NOT NULL', @nullable ) . ';'; + next; + } } push @constraint_defs, $c_def; } @@ -314,11 +231,7 @@ sub produce { # Indices # for my $index ( $table->get_indices ) { - my $idx_name = $index->name || mk_name($table_name . '_idx'); - my $idx_name_ur = unreserve($idx_name); - push @index_defs, - "CREATE INDEX $idx_name_ur ON $table_name_ur (". - join( ', ', map unreserve($_), $index->fields ) . ");"; + push @index_defs, $future->index($index) } my $create_statement = ""; @@ -372,7 +285,6 @@ sub produce { return $output; } -# ------------------------------------------------------------------- sub mk_name { my ($name, $scope, $critical) = @_; @@ -394,13 +306,10 @@ sub mk_name { return unreserve($name); } -# ------------------------------------------------------------------- -sub unreserve { $shim->quote($_[0]) } +sub unreserve { $util->quote($_[0]) } 1; -# ------------------------------------------------------------------- - =pod =head1 SEE ALSO