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
=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',
=cut
-# -------------------------------------------------------------------
sub produce {
my $translator = shift;
$DEBUG = $translator->debug;
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
"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);
}
#
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;
}
# 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 = "";
return $output;
}
-# -------------------------------------------------------------------
sub mk_name {
my ($name, $scope, $critical) = @_;
return unreserve($name);
}
-# -------------------------------------------------------------------
-sub unreserve { $shim->quote($_[0]) }
+sub unreserve { $util->quote($_[0]) }
1;
-# -------------------------------------------------------------------
-
=pod
=head1 SEE ALSO