| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package SQL::Translator::Producer; |
|
2
|
|
|
|
|
|
|
|
|
3
|
67
|
|
|
67
|
|
478
|
use strict; |
|
|
67
|
|
|
|
|
202
|
|
|
|
67
|
|
|
|
|
2048
|
|
|
4
|
67
|
|
|
67
|
|
419
|
use warnings; |
|
|
67
|
|
|
|
|
190
|
|
|
|
67
|
|
|
|
|
1547
|
|
|
5
|
67
|
|
|
67
|
|
373
|
use Scalar::Util (); |
|
|
67
|
|
|
|
|
157
|
|
|
|
67
|
|
|
|
|
28094
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '1.63'; |
|
7
|
|
|
|
|
|
|
|
|
8
|
0
|
|
|
0
|
1
|
0
|
sub produce { "" } |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# Do not rely on this if you are not bundled with SQL::Translator. |
|
11
|
|
|
|
|
|
|
# -- rjbs, 2008-09-30 |
|
12
|
|
|
|
|
|
|
## $exceptions contains an arrayref of paired values |
|
13
|
|
|
|
|
|
|
## Each pair contains a pattern match or string, and a value to be used as |
|
14
|
|
|
|
|
|
|
## the default if matched. |
|
15
|
|
|
|
|
|
|
## They are special per Producer, and provide support for the old 'now()' |
|
16
|
|
|
|
|
|
|
## default value exceptions |
|
17
|
|
|
|
|
|
|
sub _apply_default_value { |
|
18
|
367
|
|
|
367
|
|
886
|
my ($self, $field, $field_ref, $exceptions) = @_; |
|
19
|
367
|
|
|
|
|
1036
|
my $default = $field->default_value; |
|
20
|
367
|
100
|
|
|
|
1217
|
return if !defined $default; |
|
21
|
|
|
|
|
|
|
|
|
22
|
99
|
100
|
66
|
|
|
514
|
if ($exceptions and ! ref $default) { |
|
23
|
91
|
|
|
|
|
278
|
for (my $i = 0; $i < @$exceptions; $i += 2) { |
|
24
|
155
|
|
|
|
|
376
|
my ($pat, $val) = @$exceptions[ $i, $i + 1 ]; |
|
25
|
155
|
50
|
33
|
|
|
775
|
if (ref $pat and $default =~ $pat) { |
|
|
|
100
|
|
|
|
|
|
|
26
|
0
|
|
|
|
|
0
|
$default = $val; |
|
27
|
0
|
|
|
|
|
0
|
last; |
|
28
|
|
|
|
|
|
|
} elsif (lc $default eq lc $pat) { |
|
29
|
1
|
|
|
|
|
4
|
$default = $val; |
|
30
|
|
|
|
|
|
|
last |
|
31
|
1
|
|
|
|
|
3
|
} |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
|
|
35
|
99
|
|
|
|
|
317
|
my $type = lc $field->data_type; |
|
36
|
99
|
|
|
|
|
653
|
my $is_numeric_datatype = ($type =~ /^(?:(?:big|medium|small|tiny)?int(?:eger)?|decimal|double|float|num(?:ber|eric)?|real)$/); |
|
37
|
|
|
|
|
|
|
|
|
38
|
99
|
100
|
66
|
|
|
515
|
if (ref $default) { |
|
|
|
100
|
|
|
|
|
|
|
39
|
9
|
|
|
|
|
51
|
$$field_ref .= " DEFAULT $$default"; |
|
40
|
|
|
|
|
|
|
} elsif ($is_numeric_datatype && Scalar::Util::looks_like_number ($default) ) { |
|
41
|
|
|
|
|
|
|
# we need to check the data itself in addition to the datatype, for basic safety |
|
42
|
38
|
|
|
|
|
169
|
$$field_ref .= " DEFAULT $default"; |
|
43
|
|
|
|
|
|
|
} else { |
|
44
|
52
|
|
|
|
|
195
|
$default = $self->_quote_string($default); |
|
45
|
52
|
|
|
|
|
229
|
$$field_ref .= " DEFAULT $default"; |
|
46
|
|
|
|
|
|
|
} |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
} |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub _quote_string { |
|
51
|
102
|
|
|
102
|
|
333
|
my ($self, $string) = @_; |
|
52
|
102
|
|
|
|
|
231
|
$string =~ s/'/''/g; |
|
53
|
102
|
|
|
|
|
535
|
return qq{'$string'}; |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
1; |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
|
59
|
|
|
|
|
|
|
# A burnt child loves the fire. |
|
60
|
|
|
|
|
|
|
# Oscar Wilde |
|
61
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=pod |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 NAME |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
SQL::Translator::Producer - describes how to write a producer |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Producer modules designed to be used with SQL::Translator need to |
|
72
|
|
|
|
|
|
|
implement a single function, called B. B will be |
|
73
|
|
|
|
|
|
|
called with the SQL::Translator object from which it is expected to |
|
74
|
|
|
|
|
|
|
retrieve the SQL::Translator::Schema object which has been populated |
|
75
|
|
|
|
|
|
|
by the parser. It is expected to return a string. |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=head1 METHODS |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=over 4 |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item produce |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item create_table($table) |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=item create_field($field) |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=item create_view($view) |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item create_index($index) |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item create_constraint($constraint) |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=item create_trigger($trigger) |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item alter_field($from_field, $to_field) |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=item add_field($table, $new_field) |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item drop_field($table, $old_field) |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=back |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 AUTHORS |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Darren Chamberlain Edarren@cpan.orgE, |
|
106
|
|
|
|
|
|
|
Ken Y. Clark Ekclark@cpan.orgE. |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
perl(1), SQL::Translator, SQL::Translator::Schema. |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |