| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package SQL::Translator::Producer; |
|
2
|
|
|
|
|
|
|
|
|
3
|
72
|
|
|
72
|
|
504
|
use strict; |
|
|
72
|
|
|
|
|
182
|
|
|
|
72
|
|
|
|
|
2926
|
|
|
4
|
72
|
|
|
72
|
|
401
|
use warnings; |
|
|
72
|
|
|
|
|
149
|
|
|
|
72
|
|
|
|
|
3962
|
|
|
5
|
72
|
|
|
72
|
|
401
|
use Scalar::Util (); |
|
|
72
|
|
|
|
|
187
|
|
|
|
72
|
|
|
|
|
37914
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '1.66'; |
|
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
|
413
|
|
|
413
|
|
1207
|
my ($self, $field, $field_ref, $exceptions) = @_; |
|
19
|
413
|
|
|
|
|
1590
|
my $default = $field->default_value; |
|
20
|
413
|
100
|
|
|
|
1568
|
return if !defined $default; |
|
21
|
|
|
|
|
|
|
|
|
22
|
121
|
100
|
66
|
|
|
778
|
if ($exceptions and !ref $default) { |
|
23
|
113
|
|
|
|
|
465
|
for (my $i = 0; $i < @$exceptions; $i += 2) { |
|
24
|
191
|
|
|
|
|
620
|
my ($pat, $val) = @$exceptions[ $i, $i + 1 ]; |
|
25
|
191
|
50
|
33
|
|
|
1384
|
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
|
|
|
|
|
3
|
$default = $val; |
|
30
|
1
|
|
|
|
|
4
|
last; |
|
31
|
|
|
|
|
|
|
} |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
|
|
35
|
121
|
|
|
|
|
569
|
my $type = lc $field->data_type; |
|
36
|
121
|
|
|
|
|
862
|
my $is_numeric_datatype |
|
37
|
|
|
|
|
|
|
= ($type =~ /^(?:(?:big|medium|small|tiny)?int(?:eger)?|decimal|double|float|num(?:ber|eric)?|real)$/); |
|
38
|
|
|
|
|
|
|
|
|
39
|
121
|
100
|
66
|
|
|
906
|
if (ref $default) { |
|
|
|
100
|
|
|
|
|
|
|
40
|
9
|
|
|
|
|
42
|
$$field_ref .= " DEFAULT $$default"; |
|
41
|
|
|
|
|
|
|
} elsif ($is_numeric_datatype && Scalar::Util::looks_like_number($default)) { |
|
42
|
|
|
|
|
|
|
# we need to check the data itself in addition to the datatype, for basic safety |
|
43
|
42
|
|
|
|
|
205
|
$$field_ref .= " DEFAULT $default"; |
|
44
|
|
|
|
|
|
|
} else { |
|
45
|
70
|
|
|
|
|
389
|
$default = $self->_quote_string($default); |
|
46
|
70
|
|
|
|
|
331
|
$$field_ref .= " DEFAULT $default"; |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub _quote_string { |
|
52
|
132
|
|
|
132
|
|
412
|
my ($self, $string) = @_; |
|
53
|
132
|
|
|
|
|
358
|
$string =~ s/'/''/g; |
|
54
|
132
|
|
|
|
|
852
|
return qq{'$string'}; |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
1; |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
|
60
|
|
|
|
|
|
|
# A burnt child loves the fire. |
|
61
|
|
|
|
|
|
|
# Oscar Wilde |
|
62
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=pod |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 NAME |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
SQL::Translator::Producer - describes how to write a producer |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Producer modules designed to be used with SQL::Translator need to |
|
73
|
|
|
|
|
|
|
implement a single function, called B. B will be |
|
74
|
|
|
|
|
|
|
called with the SQL::Translator object from which it is expected to |
|
75
|
|
|
|
|
|
|
retrieve the SQL::Translator::Schema object which has been populated |
|
76
|
|
|
|
|
|
|
by the parser. It is expected to return a string. |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head1 METHODS |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=over 4 |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item produce |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item create_table($table) |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=item create_field($field) |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=item create_view($view) |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=item create_index($index) |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item create_constraint($constraint) |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item create_trigger($trigger) |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=item alter_field($from_field, $to_field) |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=item add_field($table, $new_field) |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=item drop_field($table, $old_field) |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=back |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head1 AUTHORS |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Darren Chamberlain Edarren@cpan.orgE, |
|
107
|
|
|
|
|
|
|
Ken Y. Clark Ekclark@cpan.orgE. |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
perl(1), SQL::Translator, SQL::Translator::Schema. |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=cut |