X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FGenerator%2FDDL%2FSQLServer.pm;h=72212295b6c77c0e504401225276aef2e06a130e;hb=1868ddbee17731eb23de17472c429c6bbf13a037;hp=0d9c5cc4cf30dfb5fdff86ed2566ca8e22d038aa;hpb=38d0ddf0677af37270825aa67edde30aa8ba13bd;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Generator/DDL/SQLServer.pm b/lib/SQL/Translator/Generator/DDL/SQLServer.pm
index 0d9c5cc..7221229 100644
--- a/lib/SQL/Translator/Generator/DDL/SQLServer.pm
+++ b/lib/SQL/Translator/Generator/DDL/SQLServer.pm
@@ -1,11 +1,24 @@
 package SQL::Translator::Generator::DDL::SQLServer;
 
+=head1 NAME
+
+SQL::Translator::Generator::DDL::SQLServer - A Moo based MS SQL Server DDL
+generation engine.
+
+=head1 DESCRIPTION
+
+I<documentation volunteers needed>
+
+=cut
+
 use Moo;
-use SQL::Translator::Generator::Utils;
+use SQL::Translator::Schema::Constants;
 
+with 'SQL::Translator::Generator::Role::Quote';
 with 'SQL::Translator::Generator::Role::DDL';
 
-sub _build_shim { SQL::Translator::Generator::Utils->new( quote_chars => [qw( [ ] )] ) }
+sub quote_chars { [qw([ ])] }
+sub name_sep { q(.) }
 
 sub _build_numeric_types {
    +{
@@ -26,11 +39,6 @@ sub _build_type_map {
    }
 }
 
-has sizeless_types => (
-   is => 'ro',
-   builder => '_build_sizeless_types',
-);
-
 sub _build_sizeless_types {
    +{ map { $_ => 1 }
          qw( tinyint smallint int integer bigint text bit image datetime ) }
@@ -45,15 +53,6 @@ sub field {
       $self->field_default($field),
 }
 
-sub field_type_size {
-   my ($self, $field) = @_;
-
-   ($field->size && !$self->sizeless_types->{$field->data_type}
-      ? '(' . $field->size . ')'
-      : ''
-   )
-}
-
 sub field_autoinc { ( $_[1]->is_auto_increment ? 'IDENTITY' : () ) }
 
 sub primary_key_constraint {
@@ -90,7 +89,7 @@ sub unique_constraint_multiple {
   'CREATE UNIQUE NONCLUSTERED INDEX ' .
    $self->unique_constraint_name($constraint) .
    ' ON ' . $self->quote($constraint->table->name) . ' (' .
-   join( ', ', $constraint->fields ) . ')' .
+   join( ', ', map $self->quote($_), $constraint->fields ) . ')' .
    ' WHERE ' . join( ' AND ',
     map $self->quote($_->name) . ' IS NOT NULL',
     grep { $_->is_nullable } $constraint->fields ) . ';'
@@ -126,5 +125,134 @@ sub foreign_key_constraint {
    ) . ';';
 }
 
+sub enum_constraint_name {
+  my ($self, $field_name) = @_;
+  $self->quote($field_name . '_chk' )
+}
+
+sub enum_constraint {
+  my ( $self, $field_name, $vals ) = @_;
+
+  return (
+     'CONSTRAINT ' . $self->enum_constraint_name($field_name) .
+       ' CHECK (' . $self->quote($field_name) .
+       ' IN (' . join( ',', map $self->quote_string($_), @$vals ) . '))'
+  )
+}
+
+sub constraints {
+  my ($self, $table) = @_;
+
+  (map $self->enum_constraint($_->name, { $_->extra }->{list} || []),
+     grep { 'enum' eq lc $_->data_type } $table->get_fields),
+
+  (map $self->primary_key_constraint($_),
+     grep { $_->type eq PRIMARY_KEY } $table->get_constraints),
+
+  (map $self->unique_constraint_single($_),
+     grep {
+       $_->type eq UNIQUE &&
+       !grep { $_->is_nullable } $_->fields
+     } $table->get_constraints),
+}
+
+sub table {
+   my ($self, $table) = @_;
+   join ( "\n", $self->table_comments($table), '' ) .
+   join ( "\n\n",
+      'CREATE TABLE ' . $self->quote($table->name) . " (\n".
+        join( ",\n",
+           map { "  $_" }
+           $self->fields($table),
+           $self->constraints($table),
+        ) .
+        "\n);",
+        $self->unique_constraints_multiple($table),
+        $self->indices($table),
+   )
+}
+
+sub unique_constraints_multiple {
+  my ($self, $table) = @_;
+  (map $self->unique_constraint_multiple($_),
+     grep {
+        $_->type eq UNIQUE &&
+        grep { $_->is_nullable } $_->fields
+     } $table->get_constraints)
+}
+
+sub drop_table {
+   my ($self, $table) = @_;
+   my $name = $table->name;
+   my $q_name = $self->quote($name);
+   "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" .
+      " DROP TABLE $q_name;"
+}
+
+sub remove_table_constraints {
+   my ($self, $table) = @_;
+   my $name = $table->name;
+   my $q_name = $self->quote($name);
+   "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" .
+   " ALTER TABLE $q_name NOCHECK CONSTRAINT all;"
+}
+
+sub drop_tables {
+   my ($self, $schema) = @_;
+
+   if ($self->add_drop_table) {
+      my @tables = sort { $b->order <=> $a->order } $schema->get_tables;
+      return join "\n", (
+         ( $self->add_comments ? (
+         '--',
+         '-- Turn off constraints',
+         '--',
+         '',
+         ) : () ),
+         (map $self->remove_table_constraints($_), @tables),
+         ( $self->add_comments ? (
+         '--',
+         '-- Drop tables',
+         '--',
+         '',
+         ) : () ),
+         (map $self->drop_table($_), @tables),
+      )
+   }
+   return '';
+}
+
+sub foreign_key_constraints {
+   my ($self, $schema) = @_;
+   ( map $self->foreign_key_constraint($_),
+     grep { $_->type eq FOREIGN_KEY }
+     map $_->get_constraints,
+     $schema->get_tables )
+}
+
+sub schema {
+   my ($self, $schema) = @_;
+
+   $self->header_comments .
+      $self->drop_tables($schema) .
+      join("\n\n", map $self->table($_), grep { $_->name } $schema->get_tables) .
+      "\n" . join "\n", $self->foreign_key_constraints($schema)
+}
+
 1;
 
+=head1 AUTHORS
+
+See the included AUTHORS file:
+L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2012 the SQL::Translator L</AUTHORS> as listed above.
+
+=head1 LICENSE
+
+This code is free software and may be distributed under the same terms as Perl
+itself.
+
+=cut