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 =pod
  53
  54 =head1 SQLServer Create Table Syntax
  55
  56 TODO
  57
  58 =cut
  59
  60 sub produce {
  61     my $translator     = shift;
  62     $DEBUG             = $translator->debug;
  63     $WARN              = $translator->show_warnings;
  64     my $no_comments    = $translator->no_comments;
  65     my $add_drop_table = $translator->add_drop_table;
  66     my $schema         = $translator->schema;
  67
  68     my $output;
  69     $output .= header_comment."\n" unless ($no_comments);
  70
  71     # Generate the DROP statements.
  72     if ($add_drop_table) {
  73         my @tables = sort { $b->order <=> $a->order } $schema->get_tables;
  74         $output .= "--\n-- Turn off constraints\n--\n\n" unless $no_comments;
  75         foreach my $table (@tables) {
  76             my $name = $table->name;
  77             my $q_name = unreserve($name);
  78             $output .= "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') ALTER TABLE $q_name NOCHECK CONSTRAINT all;\n"
  79         }
  80         $output .= "\n";
  81         $output .= "--\n-- Drop tables\n--\n\n" unless $no_comments;
  82         foreach my $table (@tables) {
  83             my $name = $table->name;
  84             my $q_name = unreserve($name);
  85             $output .= "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U') DROP TABLE $q_name;\n"
  86         }
  87     }
  88
  89     # these need to be added separately, as tables may not exist yet
  90     my @foreign_constraints = ();
  91
  92     for my $table ( grep { $_->name } $schema->get_tables ) {
  93         my $table_name_ur = unreserve($table->name);
  94
  95         my ( @comments );
  96
  97         push @comments, "\n\n--\n-- Table: $table_name_ur\n--"
  98            unless $no_comments;
  99
 100         push @comments, map { "-- $_" } $table->comments;
 101
 102         push @foreign_constraints, map $future->foreign_key_constraint($_),
 103            grep { $_->type eq FOREIGN_KEY } $table->get_constraints;
 104
 105         $output .= join( "\n\n",
 106             @comments,
 107             # index defs
 108             $future->table($table),
 109             (map $future->unique_constraint_multiple($_),
 110                grep {
 111                   $_->type eq UNIQUE &&
 112                   grep { $_->is_nullable } $_->fields
 113                } $table->get_constraints),
 114
 115             (map $future->index($_), $table->get_indices)
 116         );
 117     }
 118
 119 # Add FK constraints
 120     $output .= join ("\n", '', @foreign_constraints) if @foreign_constraints;
 121
 122 # create view/procedure are NOT prepended to the input $sql, needs
 123 # to be filled in with the proper syntax
 124
 125     return $output;
 126 }
 127
 128 =pod
 129
 130     # Text of view is already a 'create view' statement so no need to
 131     # be fancy
 132     foreach ( $schema->get_views ) {
 133         my $name = $_->name();
 134         $output .= "\n\n";
 135         $output .= "--\n-- View: $name\n--\n\n" unless $no_comments;
 136         my $text = $_->sql();
 137         $text =~ s/\r//g;
 138         $output .= "$text\nGO\n";
 139     }
 140
 141     # Text of procedure already has the 'create procedure' stuff
 142     # so there is no need to do anything fancy. However, we should
 143     # think about doing fancy stuff with granting permissions and
 144     # so on.
 145     foreach ( $schema->get_procedures ) {
 146         my $name = $_->name();
 147         $output .= "\n\n";
 148         $output .= "--\n-- Procedure: $name\n--\n\n" unless $no_comments;
 149         my $text = $_->sql();
 150       $text =~ s/\r//g;
 151         $output .= "$text\nGO\n";
 152     }
 153 =cut
 154
 155 sub unreserve { $util->quote($_[0]) }
 156
 157 1;
 158
 159 =pod
 160
 161 =head1 SEE ALSO
 162
 163 SQL::Translator.
 164
 165 =head1 AUTHORS
 166
 167 Mark Addison E<lt>grommit@users.sourceforge.netE<gt> - Bulk of code from
 168 Sybase producer, I just tweaked it for SQLServer. Thanks.
 169
 170 =cut