X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FSQLServer.pm;h=ed9d156b272c53a498a06ae163b36dcc36569011;hb=86c68a0f3f41305f6ce2d7ad1a4f9edc010c2b99;hp=a1258737ac9b826d79dc91f950912a3657e2f4b4;hpb=38d0ddf0677af37270825aa67edde30aa8ba13bd;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/SQLServer.pm b/lib/SQL/Translator/Producer/SQLServer.pm index a125873..ed9d156 100644 --- a/lib/SQL/Translator/Producer/SQLServer.pm +++ b/lib/SQL/Translator/Producer/SQLServer.pm @@ -1,5 +1,25 @@ package SQL::Translator::Producer::SQLServer; +use strict; +use warnings; +our ( $DEBUG, $WARN ); +our $VERSION = '1.59'; +$DEBUG = 1 unless defined $DEBUG; + +use SQL::Translator::Schema::Constants; +use SQL::Translator::Utils qw(debug header_comment); +use SQL::Translator::Generator::DDL::SQLServer; + +sub produce { + my $translator = shift; + SQL::Translator::Generator::DDL::SQLServer->new( + add_comments => !$translator->no_comments, + add_drop_table => $translator->add_drop_table, + )->schema($translator->schema) +} + +1; + =head1 NAME SQL::Translator::Producer::SQLServer - MS SQLServer producer for SQL::Translator @@ -13,8 +33,8 @@ SQL::Translator::Producer::SQLServer - MS SQLServer producer for SQL::Translator =head1 DESCRIPTION -BB This is still fairly early code, basically a hacked version of the -Sybase Producer (thanks Sam, Paul and Ken for doing the real work ;-) +This is currently a thin wrapper around the nextgen +L DDL maker. =head1 Extra Attributes @@ -32,190 +52,6 @@ List of values for an enum field. * Reserved words list needs updating to SQLServer. * Triggers, Procedures and Views DO NOT WORK -=cut - -use strict; -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::Generator::Utils; -use SQL::Translator::Generator::DDL::SQLServer; - -my $util = SQL::Translator::Generator::Utils->new( quote_chars => ['[', ']'] ); -my $future = SQL::Translator::Generator::DDL::SQLServer->new(); - -my %translate = ( - date => 'datetime', - 'time' => 'datetime', - # Sybase types - #integer => 'numeric', - #int => 'numeric', - #number => 'numeric', - #money => 'money', - #varchar => 'varchar', - #varchar2 => 'varchar', - #timestamp => 'datetime', - #text => 'varchar', - #real => 'double precision', - #comment => 'text', - #bit => 'bit', - #tinyint => 'smallint', - #float => 'double precision', - #serial => 'numeric', - #boolean => 'varchar', - #char => 'char', - #long => 'varchar', -); - -# If these datatypes have size appended the sql fails. -my @no_size = qw/tinyint smallint int integer bigint text bit image datetime/; - -my $max_id_length = 128; -my %global_names; - -=pod - -=head1 SQLServer Create Table Syntax - -TODO - -=cut - -sub produce { - my $translator = shift; - $DEBUG = $translator->debug; - $WARN = $translator->show_warnings; - my $no_comments = $translator->no_comments; - my $add_drop_table = $translator->add_drop_table; - my $schema = $translator->schema; - - %global_names = (); #reset - - my $output; - $output .= header_comment."\n" unless ($no_comments); - - # 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 (@tables) { - my $name = $table->name; - my $q_name = unreserve($name); - $output .= "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') DROP TABLE $q_name;\n" - } - } - - # 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; - my $table_name_ur = unreserve($table_name) || ''; - - my ( @comments, @field_defs, @index_defs, @constraint_defs ); - - push @comments, "\n\n--\n-- Table: $table_name_ur\n--" - unless $no_comments; - - push @comments, map { "-- $_" } $table->comments; - - # - # Fields - # - my %field_name_scope; - for my $field ( $table->get_fields ) { - my $field_name = $field->name; - - # - # Datatype - # - my $data_type = lc $field->data_type; - my %extra = $field->extra; - my $list = $extra{'list'} || []; - # \todo deal with embedded quotes - my $commalist = join( ', ', map { qq['$_'] } @$list ); - - if ( $data_type eq 'enum' ) { - my $check_name = mk_name( $field_name . '_chk' ); - push @constraint_defs, - "CONSTRAINT $check_name CHECK ($field_name IN ($commalist))"; - $data_type .= 'character varying'; - } - - push @field_defs, $future->field($field); - } - - # - # Constraint Declarations - # - my @constraint_decs = (); - for my $constraint ( $table->get_constraints ) { - my $type = $constraint->type || NORMAL; - next unless $constraint->fields; - - my $c_def; - if ( $type eq FOREIGN_KEY ) { - push @foreign_constraints, $future->foreign_key_constraint($constraint); - next; - } - - - if ( $type eq PRIMARY_KEY ) { - $c_def = $future->primary_key_constraint($constraint) - } - elsif ( $type eq UNIQUE ) { - if (!grep { $_->is_nullable } $constraint->fields) { - $c_def = $future->unique_constraint_single($constraint) - } else { - push @index_defs, $future->unique_constraint_multiple($constraint); - next; - } - } - push @constraint_defs, $c_def; - } - - # - # Indices - # - for my $index ( $table->get_indices ) { - push @index_defs, $future->index($index) - } - - my $create_statement = ""; - $create_statement .= qq[CREATE TABLE $table_name_ur (\n]. - join( ",\n", - map { " $_" } @field_defs, @constraint_defs - ). - "\n);" - ; - - $output .= join( "\n\n", - @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 @@ -240,45 +76,23 @@ sub produce { $text =~ s/\r//g; $output .= "$text\nGO\n"; } -=cut - - return $output; -} - -sub mk_name { - my ($name, $scope, $critical) = @_; - $scope ||= \%global_names; - if ( my $prev = $scope->{ $name } ) { - my $name_orig = $name; - $name .= sprintf( "%02d", ++$prev ); - substr($name, $max_id_length - 3) = "00" - if length( $name ) > $max_id_length; - - warn "The name '$name_orig' has been changed to ", - "'$name' to make it unique.\n" if $WARN; - - $scope->{ $name_orig }++; - } - $name = substr( $name, 0, $max_id_length ) - if ((length( $name ) > $max_id_length) && $critical); - $scope->{ $name }++; - return unreserve($name); -} +=head1 SEE ALSO -sub unreserve { $util->quote($_[0]) } +L -1; +=head1 AUTHORS -=pod +See the included AUTHORS file: +L -=head1 SEE ALSO +=head1 COPYRIGHT -SQL::Translator. +Copyright (c) 2012 the SQL::Translator L as listed above. -=head1 AUTHORS +=head1 LICENSE -Mark Addison Egrommit@users.sourceforge.netE - Bulk of code from -Sybase producer, I just tweaked it for SQLServer. Thanks. +This code is free software and may be distributed under the same terms as Perl +itself. =cut