X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FGenerator%2FRole%2FDDL.pm;h=83c8647ce2817de554d192bc9897a425aa434c4a;hb=1868ddbee17731eb23de17472c429c6bbf13a037;hp=7b6726f5ddc251e42e1509d8adbd418aaa39db94;hpb=38d0ddf0677af37270825aa67edde30aa8ba13bd;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Generator/Role/DDL.pm b/lib/SQL/Translator/Generator/Role/DDL.pm index 7b6726f..83c8647 100644 --- a/lib/SQL/Translator/Generator/Role/DDL.pm +++ b/lib/SQL/Translator/Generator/Role/DDL.pm @@ -1,32 +1,49 @@ package SQL::Translator::Generator::Role::DDL; +=head1 NAME + +SQL::Translator::Generator::Role::DDL - Role implementing common parts of +DDL generation. + +=head1 DESCRIPTION + +I + +=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', - handles => [ 'quote' ], - 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 @@ -37,14 +54,37 @@ 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 { @@ -54,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 + +=head1 COPYRIGHT + +Copyright (c) 2012 the SQL::Translator L as listed above. + +=head1 LICENSE + +This code is free software and may be distributed under the same terms as Perl +itself. + +=cut