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