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 |