lib/SQL/Translator/Producer/SQLServer.pm

   1 package SQL::Translator::Producer::SQLServer;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Producer::SQLServer - MS SQLServer producer for SQL::Translator
   6
   7 =head1 SYNOPSIS
   8
   9   use SQL::Translator;
  10
  11   my $t = SQL::Translator->new( parser => '...', producer => 'SQLServer' );
  12   $t->translate;
  13
  14 =head1 DESCRIPTION
  15
  16 B<WARNING>B This is still fairly early code, basically a hacked version of the
  17 Sybase Producer (thanks Sam, Paul and Ken for doing the real work ;-)
  18
  19 =head1 Extra Attributes
  20
  21 =over 4
  22
  23 =item field.list
  24
  25 List of values for an enum field.
  26
  27 =back
  28
  29 =head1 TODO
  30
  31  * !! Write some tests !!
  32  * Reserved words list needs updating to SQLServer.
  33  * Triggers, Procedures and Views DO NOT WORK
  34
  35 =cut
  36
  37 use strict;
  38 use warnings;
  39 our ( $DEBUG, $WARN );
  40 our $VERSION = '1.59';
  41 $DEBUG = 1 unless defined $DEBUG;
  42
  43 use Data::Dumper;
  44 use SQL::Translator::Schema::Constants;
  45 use SQL::Translator::Utils qw(debug header_comment);
  46 use SQL::Translator::Generator::Utils;
  47 use SQL::Translator::Generator::DDL::SQLServer;
  48
  49 my $util = SQL::Translator::Generator::Utils->new( quote_chars => ['[', ']'] );
  50 my $future = SQL::Translator::Generator::DDL::SQLServer->new();
  51
  52 my %translate  = (
  53     date      => 'datetime',
  54     'time'    => 'datetime',
  55     # Sybase types
  56     #integer   => 'numeric',
  57     #int       => 'numeric',
  58     #number    => 'numeric',
  59     #money     => 'money',
  60     #varchar   => 'varchar',
  61     #varchar2  => 'varchar',
  62     #timestamp => 'datetime',
  63     #text      => 'varchar',
  64     #real      => 'double precision',
  65     #comment   => 'text',
  66     #bit       => 'bit',
  67     #tinyint   => 'smallint',
  68     #float     => 'double precision',
  69     #serial    => 'numeric',
  70     #boolean   => 'varchar',
  71     #char      => 'char',
  72     #long      => 'varchar',
  73 );
  74
  75 # If these datatypes have size appended the sql fails.
  76 my @no_size = qw/tinyint smallint int integer bigint text bit image datetime/;
  77
  78 my $max_id_length    = 128;
  79 my %global_names;
  80
  81 =pod
  82
  83 =head1 SQLServer Create Table Syntax
  84
  85 TODO
  86
  87 =cut
  88
  89 sub produce {
  90     my $translator     = shift;
  91     $DEBUG             = $translator->debug;
  92     $WARN              = $translator->show_warnings;
  93     my $no_comments    = $translator->no_comments;
  94     my $add_drop_table = $translator->add_drop_table;
  95     my $schema         = $translator->schema;
  96
  97     %global_names = (); #reset
  98
  99     my $output;
 100     $output .= header_comment."\n" unless ($no_comments);
 101
 102     # Generate the DROP statements.
 103     if ($add_drop_table) {
 104         my @tables = sort { $b->order <=> $a->order } $schema->get_tables;
 105         $output .= "--\n-- Turn off constraints\n--\n\n" unless $no_comments;
 106         foreach my $table (@tables) {
 107             my $name = $table->name;
 108             my $q_name = unreserve($name);
 109             $output .= "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') ALTER TABLE $q_name NOCHECK CONSTRAINT all;\n"
 110         }
 111         $output .= "\n";
 112         $output .= "--\n-- Drop tables\n--\n\n" unless $no_comments;
 113         foreach my $table (@tables) {
 114             my $name = $table->name;
 115             my $q_name = unreserve($name);
 116             $output .= "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') DROP TABLE $q_name;\n"
 117         }
 118     }
 119
 120     # Generate the CREATE sql
 121
 122     my @foreign_constraints = (); # these need to be added separately, as tables may not exist yet
 123
 124     for my $table ( $schema->get_tables ) {
 125         my $table_name    = $table->name or next;
 126         my $table_name_ur = unreserve($table_name) || '';
 127
 128         my ( @comments, @field_defs, @index_defs, @constraint_defs );
 129
 130         push @comments, "\n\n--\n-- Table: $table_name_ur\n--"
 131         unless $no_comments;
 132
 133         push @comments, map { "-- $_" } $table->comments;
 134
 135         #
 136         # Fields
 137         #
 138         my %field_name_scope;
 139         for my $field ( $table->get_fields ) {
 140             my $field_name    = $field->name;
 141
 142             #
 143             # Datatype
 144             #
 145             my $data_type      = lc $field->data_type;
 146             my %extra          = $field->extra;
 147
 148             if ( $data_type eq 'enum' ) {
 149                 push @constraint_defs, $future->enum_constraint($field_name, $extra{'list'} || [])
 150             }
 151
 152             push @field_defs, $future->field($field);
 153         }
 154
 155         #
 156         # Constraint Declarations
 157         #
 158         my @constraint_decs = ();
 159         for my $constraint ( $table->get_constraints ) {
 160             my $type    = $constraint->type || NORMAL;
 161             next unless $constraint->fields;
 162
 163             my $c_def;
 164             if ( $type eq FOREIGN_KEY ) {
 165                 push @foreign_constraints, $future->foreign_key_constraint($constraint);
 166                 next;
 167             }
 168
 169
 170             if ( $type eq PRIMARY_KEY ) {
 171                 $c_def = $future->primary_key_constraint($constraint)
 172             }
 173             elsif ( $type eq UNIQUE ) {
 174                 if (!grep { $_->is_nullable } $constraint->fields) {
 175                   $c_def = $future->unique_constraint_single($constraint)
 176                 } else {
 177                    push @index_defs, $future->unique_constraint_multiple($constraint);
 178                    next;
 179                 }
 180             }
 181             push @constraint_defs, $c_def;
 182         }
 183
 184         #
 185         # Indices
 186         #
 187         for my $index ( $table->get_indices ) {
 188             push @index_defs, $future->index($index)
 189         }
 190
 191         my $create_statement = "";
 192         $create_statement .= qq[CREATE TABLE $table_name_ur (\n].
 193             join( ",\n",
 194                 map { "  $_" } @field_defs, @constraint_defs
 195             ).
 196             "\n);"
 197         ;
 198
 199         $output .= join( "\n\n",
 200             @comments,
 201             $create_statement,
 202             @index_defs,
 203         );
 204     }
 205
 206 # Add FK constraints
 207     $output .= join ("\n", '', @foreign_constraints) if @foreign_constraints;
 208
 209 # create view/procedure are NOT prepended to the input $sql, needs
 210 # to be filled in with the proper syntax
 211
 212 =pod
 213
 214     # Text of view is already a 'create view' statement so no need to
 215     # be fancy
 216     foreach ( $schema->get_views ) {
 217         my $name = $_->name();
 218         $output .= "\n\n";
 219         $output .= "--\n-- View: $name\n--\n\n" unless $no_comments;
 220         my $text = $_->sql();
 221         $text =~ s/\r//g;
 222         $output .= "$text\nGO\n";
 223     }
 224
 225     # Text of procedure already has the 'create procedure' stuff
 226     # so there is no need to do anything fancy. However, we should
 227     # think about doing fancy stuff with granting permissions and
 228     # so on.
 229     foreach ( $schema->get_procedures ) {
 230         my $name = $_->name();
 231         $output .= "\n\n";
 232         $output .= "--\n-- Procedure: $name\n--\n\n" unless $no_comments;
 233         my $text = $_->sql();
 234       $text =~ s/\r//g;
 235         $output .= "$text\nGO\n";
 236     }
 237 =cut
 238
 239     return $output;
 240 }
 241
 242 sub mk_name {
 243     my ($name, $scope, $critical) = @_;
 244
 245     $scope ||= \%global_names;
 246     if ( my $prev = $scope->{ $name } ) {
 247         my $name_orig = $name;
 248         $name        .= sprintf( "%02d", ++$prev );
 249         substr($name, $max_id_length - 3) = "00"
 250             if length( $name ) > $max_id_length;
 251
 252         warn "The name '$name_orig' has been changed to ",
 253              "'$name' to make it unique.\n" if $WARN;
 254
 255         $scope->{ $name_orig }++;
 256     }
 257     $name = substr( $name, 0, $max_id_length )
 258                         if ((length( $name ) > $max_id_length) && $critical);
 259     $scope->{ $name }++;
 260     return unreserve($name);
 261 }
 262
 263 sub unreserve { $util->quote($_[0]) }
 264
 265 1;
 266
 267 =pod
 268
 269 =head1 SEE ALSO
 270
 271 SQL::Translator.
 272
 273 =head1 AUTHORS
 274
 275 Mark Addison E<lt>grommit@users.sourceforge.netE<gt> - Bulk of code from
 276 Sybase producer, I just tweaked it for SQLServer. Thanks.
 277
 278 =cut