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     # these need to be added separately, as tables may not exist yet
 121     my @foreign_constraints = ();
 122
 123     for my $table ( grep { $_->name } $schema->get_tables ) {
 124         my $table_name_ur = unreserve($table->name);
 125
 126         my ( @comments );
 127
 128         push @comments, "\n\n--\n-- Table: $table_name_ur\n--"
 129            unless $no_comments;
 130
 131         push @comments, map { "-- $_" } $table->comments;
 132
 133         push @foreign_constraints, map $future->foreign_key_constraint($_),
 134            grep { $_->type eq FOREIGN_KEY } $table->get_constraints;
 135
 136         $output .= join( "\n\n",
 137             @comments,
 138             # index defs
 139             $future->table($table),
 140             (map $future->unique_constraint_multiple($_),
 141                grep {
 142                   $_->type eq UNIQUE &&
 143                   grep { $_->is_nullable } $_->fields
 144                } $table->get_constraints),
 145
 146             (map $future->index($_), $table->get_indices)
 147         );
 148     }
 149
 150 # Add FK constraints
 151     $output .= join ("\n", '', @foreign_constraints) if @foreign_constraints;
 152
 153 # create view/procedure are NOT prepended to the input $sql, needs
 154 # to be filled in with the proper syntax
 155
 156     return $output;
 157 }
 158
 159 =pod
 160
 161     # Text of view is already a 'create view' statement so no need to
 162     # be fancy
 163     foreach ( $schema->get_views ) {
 164         my $name = $_->name();
 165         $output .= "\n\n";
 166         $output .= "--\n-- View: $name\n--\n\n" unless $no_comments;
 167         my $text = $_->sql();
 168         $text =~ s/\r//g;
 169         $output .= "$text\nGO\n";
 170     }
 171
 172     # Text of procedure already has the 'create procedure' stuff
 173     # so there is no need to do anything fancy. However, we should
 174     # think about doing fancy stuff with granting permissions and
 175     # so on.
 176     foreach ( $schema->get_procedures ) {
 177         my $name = $_->name();
 178         $output .= "\n\n";
 179         $output .= "--\n-- Procedure: $name\n--\n\n" unless $no_comments;
 180         my $text = $_->sql();
 181       $text =~ s/\r//g;
 182         $output .= "$text\nGO\n";
 183     }
 184 =cut
 185
 186 sub mk_name {
 187     my ($name, $scope, $critical) = @_;
 188
 189     $scope ||= \%global_names;
 190     if ( my $prev = $scope->{ $name } ) {
 191         my $name_orig = $name;
 192         $name        .= sprintf( "%02d", ++$prev );
 193         substr($name, $max_id_length - 3) = "00"
 194             if length( $name ) > $max_id_length;
 195
 196         warn "The name '$name_orig' has been changed to ",
 197              "'$name' to make it unique.\n" if $WARN;
 198
 199         $scope->{ $name_orig }++;
 200     }
 201     $name = substr( $name, 0, $max_id_length )
 202                         if ((length( $name ) > $max_id_length) && $critical);
 203     $scope->{ $name }++;
 204     return unreserve($name);
 205 }
 206
 207 sub unreserve { $util->quote($_[0]) }
 208
 209 1;
 210
 211 =pod
 212
 213 =head1 SEE ALSO
 214
 215 SQL::Translator.
 216
 217 =head1 AUTHORS
 218
 219 Mark Addison E<lt>grommit@users.sourceforge.netE<gt> - Bulk of code from
 220 Sybase producer, I just tweaked it for SQLServer. Thanks.
 221
 222 =cut