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

   1 package SQL::Translator::Generator::Role::DDL;
   2
   3 =head1 NAME
   4
   5 SQL::Translator::Generator::Role::DDL - Role implementing common parts of
   6 DDL generation.
   7
   8 =head1 DESCRIPTION
   9
  10 I<documentation volunteers needed>
  11
  12 =cut
  13
  14 use Moo::Role;
  15 use SQL::Translator::Utils qw(header_comment);
  16 use Scalar::Util;
  17
  18 requires '_build_type_map';
  19 requires '_build_numeric_types';
  20 requires '_build_unquoted_defaults';
  21 requires '_build_sizeless_types';
  22 requires 'quote';
  23 requires 'quote_string';
  24
  25 has type_map => (
  26    is => 'lazy',
  27 );
  28
  29 has numeric_types => (
  30    is => 'lazy',
  31 );
  32
  33 has sizeless_types => (
  34    is => 'lazy',
  35 );
  36
  37 has unquoted_defaults => (
  38    is => 'lazy',
  39 );
  40
  41 has add_comments => (
  42    is => 'ro',
  43 );
  44
  45 has add_drop_table => (
  46    is => 'ro',
  47 );
  48
  49 # would also be handy to have a required size set if there is such a thing
  50
  51 sub field_name { $_[0]->quote($_[1]->name) }
  52
  53 sub field_comments {
  54    ( $_[1]->comments ? ('-- ' . $_[1]->comments . "\n ") : () )
  55 }
  56
  57 sub table_comments {
  58    my ($self, $table) = @_;
  59    if ($self->add_comments) {
  60       return (
  61          "",
  62          "--",
  63          "-- Table: " . $self->quote($table->name) . "",
  64          "--",
  65          map "-- $_", $table->comments
  66       )
  67    } else {
  68       return ()
  69    }
  70 }
  71
  72 sub field_nullable { ($_[1]->is_nullable ? $_[0]->nullable : 'NOT NULL' ) }
  73
  74 sub field_default {
  75   my ($self, $field, $exceptions) = @_;
  76
  77   my $default = $field->default_value;
  78   return () if !defined $default;
  79
  80   $default = \"$default"
  81     if $exceptions and !ref $default and $exceptions->{$default};
  82   if (ref $default) {
  83       $default = $$default;
  84   } elsif (!($self->numeric_types->{lc($field->data_type)} && Scalar::Util::looks_like_number ($default))) {
  85       $default = $self->quote_string($default);
  86   }
  87   return ( "DEFAULT $default" )
  88 }
  89
  90 sub field_type {
  91    my ($self, $field) = @_;
  92
  93    my $field_type = $field->data_type;
  94    ($self->type_map->{$field_type} || $field_type).$self->field_type_size($field)
  95 }
  96
  97 sub field_type_size {
  98    my ($self, $field) = @_;
  99
 100    ($field->size && !$self->sizeless_types->{$field->data_type}
 101       ? '(' . $field->size . ')'
 102       : ''
 103    )
 104 }
 105
 106 sub fields {
 107   my ($self, $table) = @_;
 108   ( map $self->field($_), $table->get_fields )
 109 }
 110
 111 sub indices {
 112   my ($self, $table) = @_;
 113   (map $self->index($_), $table->get_indices)
 114 }
 115
 116 sub nullable { 'NULL' }
 117
 118 sub header_comments { header_comment() . "\n" if $_[0]->add_comments }
 119
 120 1;
 121
 122 =head1 AUTHORS
 123
 124 See the included AUTHORS file:
 125 L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
 126
 127 =head1 COPYRIGHT
 128
 129 Copyright (c) 2012 the SQL::Translator L</AUTHORS> as listed above.
 130
 131 =head1 LICENSE
 132
 133 This code is free software and may be distributed under the same terms as Perl
 134 itself.
 135
 136 =cut