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

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