Escape quotes in string values in producers

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Generator / Role / DDL.pm

diff --git a/lib/SQL/Translator/Generator/Role/DDL.pm b/lib/SQL/Translator/Generator/Role/DDL.pm
index 111a864..83c8647 100644 (file)
--- a/lib/SQL/Translator/Generator/Role/DDL.pm
+++ b/lib/SQL/Translator/Generator/Role/DDL.pm
@@ -1,49 +1,90 @@
 package SQL::Translator::Generator::Role::DDL;
 
+=head1 NAME
+
+SQL::Translator::Generator::Role::DDL - Role implementing common parts of
+DDL generation.
+
+=head1 DESCRIPTION
+
+I<documentation volunteers needed>
+
+=cut
+
 use Moo::Role;
+use SQL::Translator::Utils qw(header_comment);
+use Scalar::Util;
 
-requires '_build_shim';
 requires '_build_type_map';
 requires '_build_numeric_types';
 requires '_build_unquoted_defaults';
-requires 'field_type_size';
-
-has shim => (
-   is => 'ro',
-   builder => '_build_shim',
-);
+requires '_build_sizeless_types';
+requires 'quote';
+requires 'quote_string';
 
 has type_map => (
-   is => 'ro',
-   builder => '_build_type_map',
+   is => 'lazy',
 );
 
 has numeric_types => (
-   is => 'ro',
-   builder => '_build_numeric_types',
+   is => 'lazy',
+);
+
+has sizeless_types => (
+   is => 'lazy',
 );
 
 has unquoted_defaults => (
+   is => 'lazy',
+);
+
+has add_comments => (
+   is => 'ro',
+);
+
+has add_drop_table => (
    is => 'ro',
-   builder => '_build_unquoted_defaults',
 );
 
 # would also be handy to have a required size set if there is such a thing
 
-sub field_name { $_[0]->shim->quote($_[1]->name) }
+sub field_name { $_[0]->quote($_[1]->name) }
 
 sub field_comments {
    ( $_[1]->comments ? ('-- ' . $_[1]->comments . "\n ") : () )
 }
 
+sub table_comments {
+   my ($self, $table) = @_;
+   if ($self->add_comments) {
+      return (
+         "",
+         "--",
+         "-- Table: " . $self->quote($table->name) . "",
+         "--",
+         map "-- $_", $table->comments
+      )
+   } else {
+      return ()
+   }
+}
+
 sub field_nullable { ($_[1]->is_nullable ? $_[0]->nullable : 'NOT NULL' ) }
 
 sub field_default {
-  return () if !defined $_[1]->default_value;
-
-  my $val = $_[1]->default_value;
-  $val = "'$val'" unless $_[0]->numeric_types->{$_[1]->data_type};
-  return ( "DEFAULT $val" )
+  my ($self, $field, $exceptions) = @_;
+
+  my $default = $field->default_value;
+  return () if !defined $default;
+
+  $default = \"$default"
+    if $exceptions and !ref $default and $exceptions->{$default};
+  if (ref $default) {
+      $default = $$default;
+  } elsif (!($self->numeric_types->{lc($field->data_type)} && Scalar::Util::looks_like_number ($default))) {
+      $default = $self->quote_string($default);
+  }
+  return ( "DEFAULT $default" )
 }
 
 sub field_type {
@@ -53,6 +94,43 @@ sub field_type {
    ($self->type_map->{$field_type} || $field_type).$self->field_type_size($field)
 }
 
+sub field_type_size {
+   my ($self, $field) = @_;
+
+   ($field->size && !$self->sizeless_types->{$field->data_type}
+      ? '(' . $field->size . ')'
+      : ''
+   )
+}
+
+sub fields {
+  my ($self, $table) = @_;
+  ( map $self->field($_), $table->get_fields )
+}
+
+sub indices {
+  my ($self, $table) = @_;
+  (map $self->index($_), $table->get_indices)
+}
+
 sub nullable { 'NULL' }
 
+sub header_comments { header_comment() . "\n" if $_[0]->add_comments }
+
 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