X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FSQLServer.pm;h=8affe1ae942ca0c767881da7cb5fa5cf8e91ee12;hb=44659089c28216f1984873bc4aa8641e2e0e3410;hp=ff90bc017bed7ddc0668a14978a0a1c37593a258;hpb=5c5997ef0d520da444d08c10313169a627e0c9fb;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/SQLServer.pm b/lib/SQL/Translator/Producer/SQLServer.pm index ff90bc0..8affe1a 100644 --- a/lib/SQL/Translator/Producer/SQLServer.pm +++ b/lib/SQL/Translator/Producer/SQLServer.pm @@ -1,9 +1,7 @@ package SQL::Translator::Producer::SQLServer; # ------------------------------------------------------------------- -# $Id: SQLServer.pm,v 1.6 2007-01-15 19:18:45 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 @@ -50,13 +48,13 @@ List of values for an enum field. * !! Write some tests !! * Reserved words list needs updating to SQLServer. - * Triggers, Procedures and Views havn't been tested at all. + * Triggers, Procedures and Views DO NOT WORK =cut use strict; use vars qw[ $DEBUG $WARN $VERSION ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use Data::Dumper; @@ -109,10 +107,8 @@ my %reserved = map { $_, 1 } qw[ my @no_size = qw/tinyint smallint int integer bigint text bit image datetime/; my $max_id_length = 128; -my %used_identifiers = (); my %global_names; my %unreserve; -my %truncated; =pod @@ -131,6 +127,9 @@ sub produce { my $add_drop_table = $translator->add_drop_table; my $schema = $translator->schema; + %global_names = (); #reset + %unreserve = (); + my $output; $output .= header_comment."\n" unless ($no_comments); @@ -153,9 +152,11 @@ sub produce { } # Generate the CREATE sql + + my @foreign_constraints = (); # these need to be added separately, as tables may not exist yet + for my $table ( $schema->get_tables ) { my $table_name = $table->name or next; - $table_name = mk_name( $table_name, '', undef, 1 ); my $table_name_ur = unreserve($table_name) || ''; my ( @comments, @field_defs, @index_defs, @constraint_defs ); @@ -170,9 +171,7 @@ sub produce { # my %field_name_scope; for my $field ( $table->get_fields ) { - my $field_name = mk_name( - $field->name, '', \%field_name_scope, undef,1 - ); + my $field_name = $field->name; my $field_name_ur = unreserve( $field_name, $table_name ); my $field_def = qq["$field_name_ur"]; $field_def =~ s/\"//g; @@ -189,19 +188,19 @@ sub produce { my $list = $extra{'list'} || []; # \todo deal with embedded quotes my $commalist = join( ', ', map { qq['$_'] } @$list ); - my $seq_name; if ( $data_type eq 'enum' ) { - my $check_name = mk_name( - $table_name.'_'.$field_name, 'chk' ,undef, 1 - ); + my $check_name = mk_name( $field_name . '_chk' ); push @constraint_defs, - "CONSTRAINT $check_name CHECK ($field_name IN ($commalist))"; + "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 }; @@ -254,15 +253,14 @@ sub produce { # # Default value # - my $default = $field->default_value; - if ( defined $default ) { - $field_def .= sprintf( ' DEFAULT %s', - ( $field->is_auto_increment && $seq_name ) - ? qq[nextval('"$seq_name"'::text)] : - ( $default =~ m/null/i ) ? 'NULL' : "'$default'" - ); - } - + SQL::Translator::Producer->_apply_default_value( + $field, + \$field_def, + [ + 'NULL' => \'NULL', + ], + ); + push @field_defs, $field_def; } @@ -270,11 +268,9 @@ sub produce { # Constraint Declarations # my @constraint_decs = (); - my $c_name_default; for my $constraint ( $table->get_constraints ) { my $name = $constraint->name || ''; # Make sure we get a unique name - $name = mk_name( $name, undef, undef, 1 ) if $name; my $type = $constraint->type || NORMAL; my @fields = map { unreserve( $_, $table_name ) } $constraint->fields; @@ -282,35 +278,47 @@ sub produce { $constraint->reference_fields; next unless @fields; - my $c_def; + my $c_def; + if ( $type eq FOREIGN_KEY ) { + $name ||= mk_name( $table_name . '_fk' ); + my $on_delete = uc ($constraint->on_delete || ''); + my $on_update = uc ($constraint->on_update || ''); + + # The default implicit constraint action in MSSQL is RESTRICT + # but you can not specify it explicitly. Go figure :) + for ($on_delete, $on_update) { + undef $_ if $_ eq 'RESTRICT' + } + + $c_def = + "ALTER TABLE $table_name ADD CONSTRAINT $name FOREIGN KEY". + ' (' . join( ', ', @fields ) . ') REFERENCES '. + $constraint->reference_table. + ' (' . join( ', ', @rfields ) . ')' + ; + + if ( $on_delete && $on_delete ne "NO ACTION") { + $c_def .= " ON DELETE $on_delete"; + } + if ( $on_update && $on_update ne "NO ACTION") { + $c_def .= " ON UPDATE $on_update"; + } + + $c_def .= ";"; + + push @foreign_constraints, $c_def; + next; + } + + if ( $type eq PRIMARY_KEY ) { - $name ||= mk_name( $table_name, 'pk', undef,1 ); + $name ||= mk_name( $table_name . '_pk' ); $c_def = "CONSTRAINT $name PRIMARY KEY ". '(' . join( ', ', @fields ) . ')'; } - elsif ( $type eq FOREIGN_KEY ) { - $name ||= mk_name( $table_name, 'fk', undef,1 ); - #$name = mk_name( ($name || $table_name), 'fk', undef,1 ); - $c_def = - "CONSTRAINT $name FOREIGN KEY". - ' (' . join( ', ', @fields ) . ') REFERENCES '. - $constraint->reference_table. - ' (' . join( ', ', @rfields ) . ')'; - my $on_delete = $constraint->on_delete; - if ( defined $on_delete && $on_delete ne "NO ACTION") { - $c_def .= " ON DELETE $on_delete"; - } - my $on_update = $constraint->on_update; - if ( defined $on_update && $on_update ne "NO ACTION") { - $c_def .= " ON UPDATE $on_update"; - } - } elsif ( $type eq UNIQUE ) { - $name ||= mk_name( - $table_name, - $name || ++$c_name_default,undef, 1 - ); + $name ||= mk_name( $table_name . '_uc' ); $c_def = "CONSTRAINT $name UNIQUE " . '(' . join( ', ', @fields ) . ')'; @@ -322,7 +330,7 @@ sub produce { # Indices # for my $index ( $table->get_indices ) { - my $idx_name = $index->name || mk_name($table_name,'idx',undef,1); + my $idx_name = $index->name || mk_name($table_name . '_idx'); push @index_defs, "CREATE INDEX $idx_name ON $table_name (". join( ', ', $index->fields ) . ");"; @@ -340,10 +348,17 @@ sub produce { @comments, $create_statement, @index_defs, - '' ); } +# Add FK constraints + $output .= join ("\n", '', @foreign_constraints) if @foreign_constraints; + +# create view/procedure are NOT prepended to the input $sql, needs +# to be filled in with the proper syntax + +=pod + # Text of view is already a 'create view' statement so no need to # be fancy foreach ( $schema->get_views ) { @@ -351,8 +366,8 @@ sub produce { $output .= "\n\n"; $output .= "--\n-- View: $name\n--\n\n" unless $no_comments; my $text = $_->sql(); - $text =~ s/\r//g; - $output .= $text; + $text =~ s/\r//g; + $output .= "$text\nGO\n"; } # Text of procedure already has the 'create procedure' stuff @@ -365,45 +380,16 @@ sub produce { $output .= "--\n-- Procedure: $name\n--\n\n" unless $no_comments; my $text = $_->sql(); $text =~ s/\r//g; - $output .= $text; - } - - # Warn out how we messed with the names. - if ( $WARN ) { - if ( %truncated ) { - warn "Truncated " . keys( %truncated ) . " names:\n"; - warn "\t" . join( "\n\t", sort keys %truncated ) . "\n"; - } - if ( %unreserve ) { - warn "Encounted " . keys( %unreserve ) . - " unsafe names in schema (reserved or invalid):\n"; - warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n"; - } + $output .= "$text\nGO\n"; } +=cut return $output; } # ------------------------------------------------------------------- sub mk_name { - my $basename = shift || ''; - my $type = shift || ''; - my $scope = shift || ''; - my $critical = shift || ''; - my $basename_orig = $basename; - my $max_name = $type - ? $max_id_length - (length($type) + 1) - : $max_id_length; - $basename = substr( $basename, 0, $max_name ) - if length( $basename ) > $max_name; - my $name = $type ? "${type}_$basename" : $basename; - - if ( $basename ne $basename_orig and $critical ) { - my $show_type = $type ? "+'$type'" : ""; - warn "Truncating '$basename_orig'$show_type to $max_id_length ", - "character limit to make '$name'\n" if $WARN; - $truncated{ $basename_orig } = $name; - } + my ($name, $scope, $critical) = @_; $scope ||= \%global_names; if ( my $prev = $scope->{ $name } ) {