1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
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_type_map';
requires '_build_numeric_types';
requires '_build_unquoted_defaults';
requires '_build_sizeless_types';
requires 'quote';
requires 'quote_string';
has type_map => (is => 'lazy',);
has 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',);
# would also be handy to have a required size set if there is such a thing
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 {
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 {
my ($self, $field) = @_;
my $field_type = $field->data_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
|
