line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Schema::DSL; |
2
|
8
|
|
|
8
|
|
155987
|
use 5.008_001; |
|
8
|
|
|
|
|
28
|
|
3
|
8
|
|
|
8
|
|
47
|
use strict; |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
211
|
|
4
|
8
|
|
|
8
|
|
37
|
use warnings; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
533
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.12'; |
7
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
37
|
use Carp qw/croak/; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
652
|
|
9
|
8
|
|
|
8
|
|
5127
|
use Array::Diff; |
|
8
|
|
|
|
|
146769
|
|
|
8
|
|
|
|
|
71
|
|
10
|
8
|
|
|
8
|
|
4704
|
use DBIx::Schema::DSL::Context; |
|
8
|
|
|
|
|
23
|
|
|
8
|
|
|
|
|
330
|
|
11
|
8
|
|
|
8
|
|
58
|
use SQL::Translator::Schema::Constants; |
|
8
|
|
|
|
|
9
|
|
|
8
|
|
|
|
|
646
|
|
12
|
8
|
|
|
8
|
|
39
|
use SQL::Translator::Schema::Field; |
|
8
|
|
|
|
|
9
|
|
|
8
|
|
|
|
|
429
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub context { |
15
|
105
|
|
|
105
|
1
|
2887
|
my $pkg = shift; |
16
|
105
|
50
|
|
|
|
198
|
die 'something wrong when calling context method.' if $pkg eq __PACKAGE__; |
17
|
8
|
|
|
8
|
|
37
|
no strict 'refs'; |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
571
|
|
18
|
105
|
|
66
|
|
|
89
|
${"$pkg\::CONTEXT"} ||= DBIx::Schema::DSL::Context->new; |
|
105
|
|
|
|
|
727
|
|
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# don't override CORE::int |
22
|
8
|
|
|
8
|
|
5326
|
use Pod::Functions (); |
|
8
|
|
|
|
|
19273
|
|
|
8
|
|
|
|
|
1179
|
|
23
|
|
|
|
|
|
|
my @column_methods = |
24
|
|
|
|
|
|
|
grep {!$Pod::Functions::Type{$_}} grep { /^[a-zA-Z_][0-9a-zA-Z_]*$/ } keys(%SQL::Translator::Schema::Field::type_mapping), qw/string number enum set/; |
25
|
|
|
|
|
|
|
my @column_sugars = qw/unique auto_increment unsigned null/; |
26
|
|
|
|
|
|
|
my @rev_column_sugars = qw/not_null signed/; |
27
|
|
|
|
|
|
|
my @export_dsls = qw/ |
28
|
|
|
|
|
|
|
create_database database create_table column primary_key set_primary_key add_index add_unique_index |
29
|
|
|
|
|
|
|
foreign_key has_many has_one belongs_to add_table_options default_unsigned columns pk fk |
30
|
|
|
|
|
|
|
default_not_null |
31
|
|
|
|
|
|
|
/; |
32
|
|
|
|
|
|
|
my @class_methods = qw/context output no_fk_output translate_to translator/; |
33
|
|
|
|
|
|
|
sub import { |
34
|
13
|
|
|
13
|
|
108
|
my $caller = caller; |
35
|
|
|
|
|
|
|
|
36
|
8
|
|
|
8
|
|
50
|
no strict 'refs'; |
|
8
|
|
|
|
|
10
|
|
|
8
|
|
|
|
|
13807
|
|
37
|
13
|
|
|
|
|
45
|
for my $func (@export_dsls, @column_methods, @column_sugars, @class_methods, @rev_column_sugars) { |
38
|
702
|
|
|
|
|
740
|
*{"$caller\::$func"} = \&$func; |
|
702
|
|
|
|
|
15526
|
|
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
3
|
|
|
3
|
1
|
59
|
sub create_database($) { caller->context->name(shift) } |
43
|
3
|
|
|
3
|
1
|
32
|
sub database($) { caller->context->db(shift) } |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub add_table_options { |
46
|
3
|
|
|
3
|
1
|
18
|
my $c = caller->context; |
47
|
3
|
|
|
|
|
22
|
my %opt = @_; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
$c->set_table_extra({ |
50
|
3
|
|
|
|
|
7
|
%{$c->table_extra}, |
|
3
|
|
|
|
|
23
|
|
51
|
|
|
|
|
|
|
%opt, |
52
|
|
|
|
|
|
|
}); |
53
|
|
|
|
|
|
|
|
54
|
3
|
50
|
33
|
|
|
28
|
if ($opt{mysql_charset} && $opt{mysql_charset} eq 'utf8mb4') { |
55
|
3
|
|
|
|
|
14
|
$c->default_varchar_size(191); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub default_unsigned() { |
60
|
2
|
|
|
2
|
1
|
14
|
caller->context->default_unsigned(1); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub default_not_null() { |
64
|
1
|
|
|
1
|
1
|
3
|
caller->context->default_not_null(1); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub create_table($$) { |
68
|
17
|
|
|
17
|
1
|
41
|
my ($table_name, $code) = @_; |
69
|
|
|
|
|
|
|
|
70
|
17
|
|
|
|
|
33
|
my $kls = caller; |
71
|
17
|
|
|
|
|
81
|
my $c = $kls->context; |
72
|
|
|
|
|
|
|
|
73
|
17
|
|
|
|
|
238
|
$c->_creating_table({ |
74
|
|
|
|
|
|
|
table_name => $table_name, |
75
|
|
|
|
|
|
|
columns => [], |
76
|
|
|
|
|
|
|
indices => [], |
77
|
|
|
|
|
|
|
constraints => [], |
78
|
|
|
|
|
|
|
primary_key => undef, |
79
|
|
|
|
|
|
|
}); |
80
|
|
|
|
|
|
|
|
81
|
17
|
|
|
|
|
40
|
$code->(); |
82
|
|
|
|
|
|
|
|
83
|
15
|
|
|
|
|
35
|
my $data = $c->_creating_table; |
84
|
|
|
|
|
|
|
my $table = $c->schema->add_table( |
85
|
|
|
|
|
|
|
name => $table_name, |
86
|
15
|
|
|
|
|
275
|
extra => {%{$c->table_extra}}, |
|
15
|
|
|
|
|
846
|
|
87
|
|
|
|
|
|
|
); |
88
|
15
|
|
|
|
|
10157
|
for my $column (@{ $data->{columns} }) { |
|
15
|
|
|
|
|
50
|
|
89
|
52
|
|
|
|
|
41500
|
$table->add_field(%{ $column } ); |
|
52
|
|
|
|
|
221
|
|
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
15
|
|
|
|
|
19737
|
my @columns = map {$_->{name}} @{$data->{columns}}; |
|
52
|
|
|
|
|
104
|
|
|
15
|
|
|
|
|
49
|
|
93
|
15
|
|
|
|
|
24
|
for my $index (@{ $data->{indices} }) { |
|
15
|
|
|
|
|
48
|
|
94
|
3
|
100
|
|
|
|
15
|
if (my @undefined_columns = _detect_undefined_columns(\@columns, $index->{fields})) { |
95
|
1
|
|
|
|
|
19
|
croak "Index error: Key column [@{[join ', ', @undefined_columns]}] doesn't exist in table]"; |
|
1
|
|
|
|
|
162
|
|
96
|
|
|
|
|
|
|
} |
97
|
2
|
|
|
|
|
24
|
$table->add_index(%{ $index } ); |
|
2
|
|
|
|
|
14
|
|
98
|
|
|
|
|
|
|
} |
99
|
14
|
|
|
|
|
2482
|
for my $constraint (@{ $data->{constraints} }) { |
|
14
|
|
|
|
|
44
|
|
100
|
8
|
|
|
|
|
19
|
my $cols = $constraint->{fields}; |
101
|
8
|
100
|
|
|
|
62
|
$cols = [$cols] unless ref $cols; |
102
|
8
|
50
|
|
|
|
55
|
if (my @undefined_columns = _detect_undefined_columns(\@columns, $cols)) { |
103
|
0
|
|
|
|
|
0
|
croak "Constraint error: Key column [@{[join ', ', @undefined_columns]}] doesn't exist in table]"; |
|
0
|
|
|
|
|
0
|
|
104
|
|
|
|
|
|
|
} |
105
|
8
|
|
|
|
|
82
|
$table->add_constraint(%{ $constraint } ); |
|
8
|
|
|
|
|
54
|
|
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
14
|
100
|
|
|
|
8117
|
if (my $pk = $data->{primary_key}) { |
109
|
12
|
100
|
|
|
|
46
|
$pk = [$pk] unless ref $pk; |
110
|
12
|
100
|
|
|
|
71
|
if (my @undefined_columns = _detect_undefined_columns(\@columns, $pk)) { |
111
|
1
|
|
|
|
|
8
|
croak "Primary key error: Key column [@{[join ', ', @undefined_columns]}] doesn't exist in table]"; |
|
1
|
|
|
|
|
110
|
|
112
|
|
|
|
|
|
|
} |
113
|
11
|
|
|
|
|
121
|
$table->primary_key($data->{primary_key}); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
13
|
|
|
|
|
25721
|
$c->_clear_creating_table; |
117
|
|
|
|
|
|
|
} |
118
|
17
|
|
|
17
|
1
|
1755
|
sub columns(&) {shift} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub _detect_undefined_columns { |
121
|
23
|
|
|
23
|
|
35
|
my ($set, $subset) = @_; |
122
|
|
|
|
|
|
|
|
123
|
23
|
|
|
|
|
244
|
my $diff = Array::Diff->diff([sort @$set], [sort @$subset]); |
124
|
23
|
|
|
|
|
6153
|
@{$diff->added}; |
|
23
|
|
|
|
|
66
|
|
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub column($$;%) { |
128
|
56
|
|
|
56
|
1
|
87
|
my ($column_name, $data_type, @opt) = @_; |
129
|
56
|
100
|
|
|
|
244
|
croak '`column` function called in non void context' if defined wantarray; |
130
|
|
|
|
|
|
|
|
131
|
55
|
100
|
|
|
|
114
|
if (ref $opt[0] eq 'ARRAY') { |
132
|
|
|
|
|
|
|
# enum or set |
133
|
1
|
|
|
|
|
2
|
unshift @opt, 'list'; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
55
|
100
|
|
|
|
110
|
if (@opt % 2) { |
137
|
1
|
|
|
|
|
2
|
croak "odd number elements are assined to options. arguments: [@{[join ', ', @_]}]"; |
|
1
|
|
|
|
|
136
|
|
138
|
|
|
|
|
|
|
} |
139
|
54
|
|
|
|
|
95
|
my %opt = @opt; |
140
|
54
|
50
|
|
|
|
99
|
$data_type = 'varchar' if $data_type eq 'string'; |
141
|
|
|
|
|
|
|
|
142
|
54
|
|
|
|
|
124
|
my $c = caller->context; |
143
|
|
|
|
|
|
|
|
144
|
54
|
50
|
|
|
|
140
|
my $creating_data = $c->_creating_table |
145
|
|
|
|
|
|
|
or croak q{can't call `column` method outside `create_table` method}; |
146
|
|
|
|
|
|
|
|
147
|
54
|
|
|
|
|
157
|
my %args = ( |
148
|
|
|
|
|
|
|
name => $column_name, |
149
|
|
|
|
|
|
|
data_type => uc $data_type, |
150
|
|
|
|
|
|
|
); |
151
|
|
|
|
|
|
|
|
152
|
54
|
|
|
|
|
189
|
my %map = ( |
153
|
|
|
|
|
|
|
null => 'is_nullable', |
154
|
|
|
|
|
|
|
limit => 'size', |
155
|
|
|
|
|
|
|
default => 'default_value', |
156
|
|
|
|
|
|
|
unique => 'is_unique', |
157
|
|
|
|
|
|
|
primary_key => 'is_primary_key', |
158
|
|
|
|
|
|
|
auto_increment => 'is_auto_increment', |
159
|
|
|
|
|
|
|
); |
160
|
54
|
|
|
|
|
121
|
for my $key (keys %map) { |
161
|
324
|
100
|
|
|
|
561
|
$args{$map{$key}} = delete $opt{$key} if exists $opt{$key}; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
%args = ( |
164
|
54
|
|
|
|
|
198
|
%args, |
165
|
|
|
|
|
|
|
%opt |
166
|
|
|
|
|
|
|
); |
167
|
|
|
|
|
|
|
|
168
|
54
|
100
|
100
|
|
|
290
|
if (exists $args{unsigned}) { |
|
|
100
|
|
|
|
|
|
169
|
3
|
|
|
|
|
7
|
$args{extra}{unsigned} = delete $args{unsigned}; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
elsif ($c->default_unsigned && $data_type =~ /int(?:eger)?$/) { |
172
|
9
|
|
|
|
|
21
|
$args{extra}{unsigned} = 1; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
54
|
100
|
|
|
|
92
|
if (exists $args{on_update}) { |
176
|
1
|
|
|
|
|
2
|
$args{extra}{'on update'} = delete $args{on_update}; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
54
|
100
|
|
|
|
93
|
if (exists $args{list}) { |
180
|
1
|
|
|
|
|
5
|
$args{extra}{list} = delete $args{list}; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
|
184
|
54
|
100
|
100
|
|
|
204
|
if ( !exists $args{is_nullable} && $c->default_not_null ) { |
185
|
2
|
|
|
|
|
3
|
$args{is_nullable} = 0; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
54
|
100
|
66
|
|
|
148
|
if ($args{data_type} eq 'VARCHAR' && !$args{size}) { |
189
|
15
|
|
|
|
|
39
|
$args{size} = $c->default_varchar_size; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
54
|
100
|
|
|
|
94
|
if ($args{precision}) { |
193
|
2
|
|
|
|
|
5
|
my $precision = delete $args{precision}; |
194
|
2
|
|
50
|
|
|
9
|
my $scale = delete $args{scale} || 0; |
195
|
2
|
|
|
|
|
7
|
$args{size} = [$precision, $scale]; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
54
|
100
|
|
|
|
126
|
if ($args{is_primary_key}) { |
|
|
100
|
|
|
|
|
|
199
|
12
|
|
|
|
|
22
|
$creating_data->{primary_key} = $column_name; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
elsif ($args{is_unique}) { |
202
|
5
|
|
|
|
|
7
|
push @{$creating_data->{constraints}}, { |
|
5
|
|
|
|
|
29
|
|
203
|
|
|
|
|
|
|
name => "${column_name}_uniq", |
204
|
|
|
|
|
|
|
fields => [$column_name], |
205
|
|
|
|
|
|
|
type => UNIQUE, |
206
|
|
|
|
|
|
|
}; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# explicitly add `DEFAULT NULL` if is_nullable and not specified default_value |
210
|
54
|
50
|
66
|
|
|
182
|
if ($args{is_nullable} && !exists $args{default_value} && $args{data_type} !~ /^(?:TINY|MEDIUM|LONG)?(?:TEXT|BLOB)$/ ) { |
|
|
|
66
|
|
|
|
|
211
|
10
|
|
|
|
|
14
|
$args{default_value} = \'NULL'; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
54
|
|
|
|
|
49
|
push @{$creating_data->{columns}}, \%args; |
|
54
|
|
|
|
|
242
|
|
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub primary_key { |
218
|
9
|
100
|
|
9
|
1
|
92
|
if (defined wantarray) { |
219
|
7
|
|
|
|
|
32
|
(primary_key => 1); |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
else { # void context |
222
|
2
|
|
|
|
|
5
|
my $column_name = shift; |
223
|
|
|
|
|
|
|
|
224
|
2
|
|
|
|
|
9
|
@_ = ($column_name, 'integer', primary_key(), auto_increment(), @_); |
225
|
2
|
|
|
|
|
9
|
goto \&column; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
*pk = \&primary_key; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
for my $method (@column_methods) { |
231
|
8
|
|
|
8
|
|
49
|
no strict 'refs'; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
479
|
|
232
|
|
|
|
|
|
|
*{__PACKAGE__."::$method"} = sub { |
233
|
8
|
|
|
8
|
|
39
|
use strict 'refs'; |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
651
|
|
234
|
51
|
|
|
51
|
|
94
|
my $column_name = shift; |
235
|
|
|
|
|
|
|
|
236
|
51
|
|
|
|
|
146
|
@_ = ($column_name, $method, @_); |
237
|
51
|
|
|
|
|
113
|
goto \&column; |
238
|
|
|
|
|
|
|
}; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
for my $method (@column_sugars) { |
242
|
8
|
|
|
8
|
|
39
|
no strict 'refs'; |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
377
|
|
243
|
|
|
|
|
|
|
*{__PACKAGE__."::$method"} = sub() { |
244
|
8
|
|
|
8
|
|
38
|
use strict 'refs'; |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
5491
|
|
245
|
20
|
|
|
20
|
|
97
|
($method => 1); |
246
|
|
|
|
|
|
|
}; |
247
|
|
|
|
|
|
|
} |
248
|
0
|
|
|
0
|
1
|
0
|
sub not_null() { (null => 0) } |
249
|
0
|
|
|
0
|
1
|
0
|
sub signed() { (unsigned => 0) } |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub set_primary_key(@) { |
252
|
3
|
|
|
3
|
1
|
8
|
my @keys = @_; |
253
|
|
|
|
|
|
|
|
254
|
3
|
|
|
|
|
14
|
my $c = caller->context; |
255
|
|
|
|
|
|
|
|
256
|
3
|
50
|
|
|
|
19
|
my $creating_data = $c->_creating_table |
257
|
|
|
|
|
|
|
or die q{can't call `set_primary_key` method outside `create_table` method}; |
258
|
|
|
|
|
|
|
|
259
|
3
|
|
|
|
|
11
|
$creating_data->{primary_key} = \@keys; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub add_index { |
263
|
2
|
|
|
2
|
1
|
8
|
my $c = caller->context; |
264
|
|
|
|
|
|
|
|
265
|
2
|
50
|
|
|
|
12
|
my $creating_data = $c->_creating_table |
266
|
|
|
|
|
|
|
or die q{can't call `add_index` method outside `create_table` method}; |
267
|
|
|
|
|
|
|
|
268
|
2
|
|
|
|
|
6
|
my ($idx_name, $fields, $type) = @_; |
269
|
|
|
|
|
|
|
|
270
|
2
|
50
|
|
|
|
4
|
push @{$creating_data->{indices}}, { |
|
2
|
|
|
|
|
13
|
|
271
|
|
|
|
|
|
|
name => $idx_name, |
272
|
|
|
|
|
|
|
fields => $fields, |
273
|
|
|
|
|
|
|
($type ? (type => $type) : ()), |
274
|
|
|
|
|
|
|
}; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub add_unique_index { |
278
|
1
|
|
|
1
|
1
|
3
|
my $c = caller->context; |
279
|
|
|
|
|
|
|
|
280
|
1
|
50
|
|
|
|
4
|
my $creating_data = $c->_creating_table |
281
|
|
|
|
|
|
|
or die q{can't call `add_unique_index` method outside `create_table` method}; |
282
|
|
|
|
|
|
|
|
283
|
1
|
|
|
|
|
2
|
my ($idx_name, $fields) = @_; |
284
|
|
|
|
|
|
|
|
285
|
1
|
|
|
|
|
1
|
push @{$creating_data->{indices}}, { |
|
1
|
|
|
|
|
3
|
|
286
|
|
|
|
|
|
|
name => $idx_name, |
287
|
|
|
|
|
|
|
fields => $fields, |
288
|
|
|
|
|
|
|
type => UNIQUE, |
289
|
|
|
|
|
|
|
}; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub foreign_key { |
293
|
4
|
|
|
4
|
1
|
15
|
my $c = caller->context; |
294
|
|
|
|
|
|
|
|
295
|
4
|
50
|
|
|
|
16
|
my $creating_data = $c->_creating_table |
296
|
|
|
|
|
|
|
or die q{can't call `foreign` method outside `create_table` method}; |
297
|
|
|
|
|
|
|
|
298
|
4
|
|
|
|
|
9
|
my ($columns, $table, $foreign_columns, %opt) = @_; |
299
|
|
|
|
|
|
|
|
300
|
4
|
|
|
|
|
6
|
push @{$creating_data->{constraints}}, { |
|
4
|
|
|
|
|
28
|
|
301
|
|
|
|
|
|
|
type => FOREIGN_KEY, |
302
|
|
|
|
|
|
|
fields => $columns, |
303
|
|
|
|
|
|
|
reference_table => $table, |
304
|
|
|
|
|
|
|
reference_fields => $foreign_columns, |
305
|
|
|
|
|
|
|
%opt, |
306
|
|
|
|
|
|
|
}; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
*fk = \&foreign_key; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub has_many { |
311
|
2
|
|
|
2
|
1
|
16
|
my $c = caller->context; |
312
|
|
|
|
|
|
|
|
313
|
2
|
|
|
|
|
6
|
my ($table, %opt) = @_; |
314
|
|
|
|
|
|
|
|
315
|
2
|
|
50
|
|
|
16
|
my $columns = delete $opt{column} || 'id'; |
316
|
2
|
|
33
|
|
|
17
|
my $foreign_columns = delete $opt{foreign_column} || $c->_creating_table_name .'_id'; |
317
|
|
|
|
|
|
|
|
318
|
2
|
|
|
|
|
10
|
@_ = ($columns, $table, $foreign_columns, %opt); |
319
|
2
|
|
|
|
|
10
|
goto \&foreign_key; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub has_one { |
323
|
0
|
|
|
0
|
1
|
0
|
my $c = caller->context; |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
0
|
my ($table, %opt) = @_; |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
0
|
|
|
0
|
my $columns = delete $opt{column} || 'id'; |
328
|
0
|
|
0
|
|
|
0
|
my $foreign_columns = delete $opt{foreign_column} || $c->_creating_table_name .'_id'; |
329
|
|
|
|
|
|
|
|
330
|
0
|
|
|
|
|
0
|
@_ = ($columns, $table, $foreign_columns, %opt); |
331
|
0
|
|
|
|
|
0
|
goto \&foreign_key; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub belongs_to { |
335
|
2
|
|
|
2
|
1
|
5
|
my ($table, %opt) = @_; |
336
|
|
|
|
|
|
|
|
337
|
2
|
|
33
|
|
|
11
|
my $columns = delete $opt{column} || "${table}_id"; |
338
|
2
|
|
50
|
|
|
12
|
my $foreign_columns = delete $opt{foreign_column} || 'id'; |
339
|
|
|
|
|
|
|
|
340
|
2
|
|
|
|
|
7
|
@_ = ($columns, $table, $foreign_columns, %opt); |
341
|
2
|
|
|
|
|
8
|
goto \&foreign_key; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub output { |
345
|
5
|
|
|
5
|
1
|
17697
|
shift->context->translate; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
sub no_fk_output { |
349
|
1
|
|
|
1
|
1
|
2855
|
shift->context->no_fk_translate; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub translator { |
353
|
1
|
|
|
1
|
1
|
3
|
shift->context->translator; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub translate_to { |
357
|
1
|
|
|
1
|
1
|
2
|
my ($kls, $db_type) = @_; |
358
|
|
|
|
|
|
|
|
359
|
1
|
|
|
|
|
4
|
$kls->translator->translate(to => $db_type); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
1; |
363
|
|
|
|
|
|
|
__END__ |