lib/SQL/Translator/Generator/Role/DDL.pm

   1 package SQL::Translator::Generator::Role::DDL;
   2
   3 # AUTHOR: Arthur Axel fREW Schmidt
   4 # Copyright: Same as Perl 5
   5
   6 use Moo::Role;
   7 use SQL::Translator::Utils qw(header_comment);
   8 use Scalar::Util;
   9
  10 requires '_build_type_map';
  11 requires '_build_numeric_types';
  12 requires '_build_unquoted_defaults';
  13 requires '_build_sizeless_types';
  14 requires 'quote';
  15
  16 has type_map => (
  17    is => 'lazy',
  18 );
  19
  20 has numeric_types => (
  21    is => 'lazy',
  22 );
  23
  24 has sizeless_types => (
  25    is => 'lazy',
  26 );
  27
  28 has unquoted_defaults => (
  29    is => 'lazy',
  30 );
  31
  32 has add_comments => (
  33    is => 'ro',
  34 );
  35
  36 has add_drop_table => (
  37    is => 'ro',
  38 );
  39
  40 # would also be handy to have a required size set if there is such a thing
  41
  42 sub field_name { $_[0]->quote($_[1]->name) }
  43
  44 sub field_comments {
  45    ( $_[1]->comments ? ('-- ' . $_[1]->comments . "\n ") : () )
  46 }
  47
  48 sub table_comments {
  49    my ($self, $table) = @_;
  50    if ($self->add_comments) {
  51       return (
  52          "",
  53          "--",
  54          "-- Table: " . $self->quote($table->name) . "",
  55          "--",
  56          map "-- $_", $table->comments
  57       )
  58    } else {
  59       return ()
  60    }
  61 }
  62
  63 sub field_nullable { ($_[1]->is_nullable ? $_[0]->nullable : 'NOT NULL' ) }
  64
  65 sub field_default {
  66   my ($self, $field, $exceptions) = @_;
  67
  68   my $default = $field->default_value;
  69   return () if !defined $default;
  70
  71   $default = \"$default"
  72     if $exceptions and !ref $default and $exceptions->{$default};
  73   if (ref $default) {
  74       $default = $$default;
  75   } elsif (!($self->numeric_types->{lc($field->data_type)} && Scalar::Util::looks_like_number ($default))) {
  76      $default = "'$default'";
  77   }
  78   return ( "DEFAULT $default" )
  79 }
  80
  81 sub field_type {
  82    my ($self, $field) = @_;
  83
  84    my $field_type = $field->data_type;
  85    ($self->type_map->{$field_type} || $field_type).$self->field_type_size($field)
  86 }
  87
  88 sub field_type_size {
  89    my ($self, $field) = @_;
  90
  91    ($field->size && !$self->sizeless_types->{$field->data_type}
  92       ? '(' . $field->size . ')'
  93       : ''
  94    )
  95 }
  96
  97 sub fields {
  98   my ($self, $table) = @_;
  99   ( map $self->field($_), $table->get_fields )
 100 }
 101
 102 sub indices {
 103   my ($self, $table) = @_;
 104   (map $self->index($_), $table->get_indices)
 105 }
 106
 107 sub nullable { 'NULL' }
 108
 109 sub header_comments { header_comment() . "\n" if $_[0]->add_comments }
 110
 111 1;