| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package DBIx::Custom::Model; |
|
2
|
17
|
|
|
17
|
|
86076
|
use Object::Simple -base; |
|
|
17
|
|
|
|
|
1304
|
|
|
|
17
|
|
|
|
|
107
|
|
|
3
|
|
|
|
|
|
|
|
|
4
|
17
|
|
|
17
|
|
1992
|
use Carp 'confess'; |
|
|
17
|
|
|
|
|
35
|
|
|
|
17
|
|
|
|
|
1012
|
|
|
5
|
17
|
|
|
17
|
|
564
|
use DBIx::Custom::Util qw/_subname _deprecate/; |
|
|
17
|
|
|
|
|
34
|
|
|
|
17
|
|
|
|
|
5105
|
|
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
has [qw/dbi table name ctime mtime bind_type join/]; |
|
8
|
|
|
|
|
|
|
has columns => sub { [] }; |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $AUTOLOAD; |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my @methods = qw(insert update update_all delete delete_all select count); |
|
13
|
|
|
|
|
|
|
for my $method (@methods) { |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $code = |
|
16
|
|
|
|
|
|
|
qq/sub {/ . |
|
17
|
|
|
|
|
|
|
qq/my \$self = shift;/ . |
|
18
|
|
|
|
|
|
|
qq/\$self->dbi->$method(/ . |
|
19
|
|
|
|
|
|
|
qq/\@_ % 2 ? shift : (),/; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my @attrs = qw/table type primary_key bind_type/; |
|
23
|
|
|
|
|
|
|
my @insert_attrs = qw/ctime mtime/; |
|
24
|
|
|
|
|
|
|
my @update_attrs = qw/mtime/; |
|
25
|
|
|
|
|
|
|
my @select_attrs = qw/join/; |
|
26
|
|
|
|
|
|
|
if ($method eq 'insert') { push @attrs, @insert_attrs } |
|
27
|
|
|
|
|
|
|
elsif ($method eq 'update') { push @attrs, @update_attrs } |
|
28
|
|
|
|
|
|
|
elsif (index($method, 'select') != -1 || $method eq 'count') { |
|
29
|
|
|
|
|
|
|
push @attrs, @select_attrs |
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
for my $attr (@attrs) { |
|
33
|
|
|
|
|
|
|
$code .= "exists \$self->{$attr} ? ($attr => \$self->{$attr}) : (),"; |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$code .= qq/\@_);/ . |
|
37
|
|
|
|
|
|
|
qq/}/; |
|
38
|
|
|
|
|
|
|
|
|
39
|
17
|
|
|
17
|
|
128
|
no strict 'refs'; |
|
|
17
|
|
|
|
|
37
|
|
|
|
17
|
|
|
|
|
16314
|
|
|
40
|
39
|
100
|
|
39
|
|
3964
|
*{__PACKAGE__ . "::$method"} = eval $code; |
|
|
39
|
50
|
|
|
|
658
|
|
|
|
45
|
50
|
|
|
|
5657
|
|
|
|
45
|
50
|
|
|
|
797
|
|
|
|
21
|
50
|
|
|
|
1277
|
|
|
|
21
|
100
|
|
|
|
357
|
|
|
|
24
|
100
|
|
|
|
1233
|
|
|
|
24
|
100
|
|
|
|
779
|
|
|
|
20
|
100
|
|
|
|
1225
|
|
|
|
20
|
50
|
|
|
|
333
|
|
|
|
5
|
50
|
|
|
|
154
|
|
|
|
5
|
50
|
|
|
|
87
|
|
|
|
45
|
100
|
|
|
|
4276
|
|
|
|
45
|
100
|
|
|
|
776
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
confess $code if $@; |
|
42
|
|
|
|
|
|
|
} |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# DEPRECATED |
|
45
|
|
|
|
|
|
|
sub primary_key { |
|
46
|
169
|
100
|
|
169
|
1
|
445
|
if (@_ == 1) { |
|
47
|
166
|
|
|
|
|
324
|
return $_[0]{'primary_key'}; |
|
48
|
|
|
|
|
|
|
} |
|
49
|
3
|
|
|
|
|
9
|
$_[0]{'primary_key'} = $_[1]; |
|
50
|
3
|
|
|
|
|
7
|
$_[0]; |
|
51
|
|
|
|
|
|
|
}; |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# DEPRECATED |
|
54
|
|
|
|
|
|
|
sub update_or_insert { |
|
55
|
8
|
|
|
8
|
0
|
140
|
my ($self, $param, %opt) = @_; |
|
56
|
|
|
|
|
|
|
|
|
57
|
8
|
|
|
|
|
37
|
_deprecate('0.39', "DBIx::Custom::Model::update_or_insert method is DEPRECATED!"); |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
confess "update_or_insert method need primary_key and id option " |
|
60
|
|
|
|
|
|
|
unless (defined $opt{id} || defined $self->{id}) |
|
61
|
8
|
50
|
33
|
|
|
266
|
&& (defined $opt{primary_key} || defined $self->{primary_key}); |
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
|
63
|
8
|
|
50
|
|
|
39
|
my $statement_opt = $opt{option} || {}; |
|
64
|
8
|
50
|
|
|
|
26
|
my $rows = $self->select(%opt, %{$statement_opt->{select} || {}})->all; |
|
|
8
|
|
|
|
|
226
|
|
|
65
|
8
|
100
|
|
|
|
110
|
if (@$rows == 0) { |
|
|
|
50
|
|
|
|
|
|
|
66
|
5
|
50
|
|
|
|
20
|
return $self->insert($param, %opt, %{$statement_opt->{insert} || {}}); |
|
|
5
|
|
|
|
|
151
|
|
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
elsif (@$rows == 1) { |
|
69
|
0
|
0
|
|
|
|
0
|
return $self->update($param, %opt, %{$statement_opt->{update} || {}}); |
|
|
0
|
|
|
|
|
0
|
|
|
70
|
|
|
|
|
|
|
} |
|
71
|
3
|
|
|
|
|
15
|
else { confess "selected row must be one " . _subname } |
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# DEPRECATED |
|
75
|
|
|
|
|
|
|
sub AUTOLOAD { |
|
76
|
33
|
|
|
33
|
|
8486
|
my $self = shift; |
|
77
|
|
|
|
|
|
|
|
|
78
|
33
|
|
|
|
|
134
|
_deprecate('0.39', "DBIx::Custom::Model AUTOLOAD feature is DEPRECATED!"); |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Method name |
|
81
|
33
|
|
|
|
|
266
|
my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/; |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Method |
|
84
|
33
|
|
100
|
|
|
181
|
$self->{_methods} ||= {}; |
|
85
|
33
|
100
|
0
|
|
|
675
|
if (my $method = $self->{_methods}->{$mname}) { |
|
|
|
50
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
86
|
3
|
|
|
|
|
16
|
return $self->$method(@_) |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
elsif (my $dbi_method = $self->dbi->can($mname)) { |
|
89
|
30
|
|
|
|
|
744
|
$self->dbi->$dbi_method(@_); |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) { |
|
92
|
0
|
|
|
|
|
0
|
$self->dbi->dbh->$dbh_method(@_); |
|
93
|
|
|
|
|
|
|
} |
|
94
|
|
|
|
|
|
|
else { |
|
95
|
0
|
|
|
|
|
0
|
confess qq{Can't locate object method "$mname" via "$package" } |
|
96
|
|
|
|
|
|
|
. _subname; |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
} |
|
99
|
|
|
|
0
|
|
|
sub DESTROY { } |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# DEPRECATED |
|
102
|
|
|
|
|
|
|
sub helper { |
|
103
|
3
|
|
|
3
|
0
|
51
|
my $self = shift; |
|
104
|
|
|
|
|
|
|
|
|
105
|
3
|
|
|
|
|
17
|
_deprecate('0.39', "DBIx::Custom::Model::helper method is DEPRECATED!"); |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Merge |
|
108
|
3
|
50
|
|
|
|
18
|
my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
109
|
3
|
50
|
|
|
|
10
|
$self->{_methods} = {%{$self->{_methods} || {}}, %$methods}; |
|
|
3
|
|
|
|
|
28
|
|
|
110
|
|
|
|
|
|
|
|
|
111
|
3
|
|
|
|
|
12
|
return $self; |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub mycolumn { |
|
115
|
24
|
|
|
24
|
1
|
6114
|
my $self = shift; |
|
116
|
24
|
100
|
|
|
|
88
|
my $table = shift unless ref $_[0]; |
|
117
|
24
|
|
|
|
|
49
|
my $columns = shift; |
|
118
|
|
|
|
|
|
|
|
|
119
|
24
|
|
50
|
|
|
504
|
$table ||= $self->table || ''; |
|
|
|
|
66
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
|
121
|
24
|
|
66
|
|
|
516
|
$columns ||= $self->columns; |
|
122
|
|
|
|
|
|
|
|
|
123
|
24
|
|
|
|
|
527
|
return $self->dbi->mycolumn($table, $columns); |
|
124
|
|
|
|
|
|
|
} |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub new { |
|
127
|
223
|
|
|
223
|
1
|
830
|
my $self = shift->SUPER::new(@_); |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# Check attribute names |
|
130
|
223
|
|
|
|
|
2931
|
my @attrs = keys %$self; |
|
131
|
223
|
|
|
|
|
504
|
for my $attr (@attrs) { |
|
132
|
283
|
50
|
|
|
|
1467
|
confess qq{"$attr" is invalid attribute name } . _subname |
|
133
|
|
|
|
|
|
|
unless $self->can($attr); |
|
134
|
|
|
|
|
|
|
} |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# Cache |
|
137
|
223
|
|
|
|
|
495
|
for my $attr (qw/dbi table ctime mtime bind_type join primary_key/) { |
|
138
|
1561
|
|
|
|
|
26563
|
$self->$attr; |
|
139
|
1561
|
100
|
|
|
|
10464
|
$self->{$attr} = undef unless exists $self->{$attr}; |
|
140
|
|
|
|
|
|
|
} |
|
141
|
223
|
|
|
|
|
4154
|
$self->columns; |
|
142
|
|
|
|
|
|
|
|
|
143
|
223
|
|
|
|
|
679
|
return $self; |
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
1; |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 NAME |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
DBIx::Custom::Model - Model object |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
use DBIx::Custom::Model; |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
my $model = DBIx::Custom::Model->new(table => 'books'); |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 name |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
my $name = $model->name; |
|
163
|
|
|
|
|
|
|
$model = $model->name('book'); |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Model name. |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head2 table |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
my $table = $model->table; |
|
170
|
|
|
|
|
|
|
$model = $model->table('book'); |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Table name, this is passed to C, C, C, C, C, C |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head2 join |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
my $join = $model->join; |
|
177
|
|
|
|
|
|
|
$model = $model->join( |
|
178
|
|
|
|
|
|
|
['left outer join company on book.company_id = company.id'] |
|
179
|
|
|
|
|
|
|
); |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Join clause, this value is passed to C |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head2 dbi |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my $dbi = $model->dbi; |
|
186
|
|
|
|
|
|
|
$model = $model->dbi($dbi); |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
L object. |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head2 bind_type |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
my $type = $model->bind_type; |
|
193
|
|
|
|
|
|
|
$model = $model->bind_type(['image' => DBI::SQL_BLOB]); |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Database data type, this is used as type option of C, |
|
196
|
|
|
|
|
|
|
C, C, C, C, |
|
197
|
|
|
|
|
|
|
and C |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head2 mtime |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
my $mtime = $model->mtime; |
|
202
|
|
|
|
|
|
|
$model = $model->mtime('modified_time'); |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
Updated timestamp column, this is passed to C method. |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 ctime |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
my $ctime = $model->ctime; |
|
209
|
|
|
|
|
|
|
$model = $model->ctime('created_time'); |
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
Create timestamp column, this is passed to C or C method. |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 primary_key |
|
214
|
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my $primary_key = $model->primary_key; |
|
216
|
|
|
|
|
|
|
$model = $model->primary_key(['id', 'number']); |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Primary key,this is passed to C, C, |
|
219
|
|
|
|
|
|
|
C, and C |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head1 METHODS |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
L inherits all methods from L, |
|
224
|
|
|
|
|
|
|
and you can use all methods of L and L |
|
225
|
|
|
|
|
|
|
and implements the following new ones. |
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head2 delete |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
$model->delete(...); |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Same as C of L except that |
|
232
|
|
|
|
|
|
|
you don't have to specify options if you set attribute in model. |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 delete_all |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
$model->delete_all(...); |
|
237
|
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Same as C of L except that |
|
239
|
|
|
|
|
|
|
you don't have to specify options if you set attribute in model. |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head2 insert |
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
$model->insert(...); |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Same as C of L except that |
|
246
|
|
|
|
|
|
|
you don't have to specify options if you set attribute in model. |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=head2 mycolumn |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
my $column = $self->mycolumn; |
|
251
|
|
|
|
|
|
|
my $column = $self->mycolumn(book => ['author', 'title']); |
|
252
|
|
|
|
|
|
|
my $column = $self->mycolumn(['author', 'title']); |
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Create column clause for myself. The following column clause is created. |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
book.author as author, |
|
257
|
|
|
|
|
|
|
book.title as title |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
If table name is omitted, C attribute of the model is used.
|
260
|
|
|
|
|
|
|
If column names is omitted, C attribute of the model is used. |
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=head2 new |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my $model = DBIx::Custom::Model->new; |
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Create a L object. |
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 select |
|
269
|
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
$model->select(...); |
|
271
|
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
Same as C |
|
273
|
|
|
|
|
|
|
you don't have to specify options if you set attribute in model. |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head2 update |
|
276
|
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
$model->update(...); |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
Same as C of L except that |
|
280
|
|
|
|
|
|
|
you don't have to specify options if you set attribute in model. |
|
281
|
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=head2 update_all |
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
$model->update_all(\%param); |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
Same as C of L except that |
|
287
|
|
|
|
|
|
|
you don't have to specify options if you set attribute in model. |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=cut |
|