| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package DBIx::QuickORM::Handle; |
|
2
|
24
|
|
|
24
|
|
1985
|
use strict; |
|
|
24
|
|
|
|
|
60
|
|
|
|
24
|
|
|
|
|
1135
|
|
|
3
|
24
|
|
|
24
|
|
138
|
use warnings; |
|
|
24
|
|
|
|
|
55
|
|
|
|
24
|
|
|
|
|
1422
|
|
|
4
|
24
|
|
|
24
|
|
149
|
use feature qw/state/; |
|
|
24
|
|
|
|
|
81
|
|
|
|
24
|
|
|
|
|
5277
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.000019'; |
|
7
|
|
|
|
|
|
|
|
|
8
|
24
|
|
|
24
|
|
198
|
use Carp qw/confess croak carp/; |
|
|
24
|
|
|
|
|
96
|
|
|
|
24
|
|
|
|
|
2124
|
|
|
9
|
24
|
|
|
24
|
|
182
|
use Sub::Util qw/set_subname/; |
|
|
24
|
|
|
|
|
63
|
|
|
|
24
|
|
|
|
|
2432
|
|
|
10
|
24
|
|
|
24
|
|
178
|
use List::Util qw/mesh/; |
|
|
24
|
|
|
|
|
60
|
|
|
|
24
|
|
|
|
|
9703
|
|
|
11
|
24
|
|
|
24
|
|
167
|
use Scalar::Util qw/blessed/; |
|
|
24
|
|
|
|
|
68
|
|
|
|
24
|
|
|
|
|
1470
|
|
|
12
|
24
|
|
|
24
|
|
185
|
use DBIx::QuickORM::Util qw{debug}; |
|
|
24
|
|
|
|
|
55
|
|
|
|
24
|
|
|
|
|
212
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
24
|
|
|
24
|
|
20524
|
use DBIx::QuickORM::STH(); |
|
|
24
|
|
|
|
|
156
|
|
|
|
24
|
|
|
|
|
847
|
|
|
15
|
24
|
|
|
24
|
|
29254
|
use DBIx::QuickORM::STH::Fork(); |
|
|
24
|
|
|
|
|
121
|
|
|
|
24
|
|
|
|
|
968
|
|
|
16
|
24
|
|
|
24
|
|
20745
|
use DBIx::QuickORM::STH::Aside(); |
|
|
24
|
|
|
|
|
121
|
|
|
|
24
|
|
|
|
|
1239
|
|
|
17
|
24
|
|
|
24
|
|
297
|
use DBIx::QuickORM::STH::Async(); |
|
|
24
|
|
|
|
|
62
|
|
|
|
24
|
|
|
|
|
637
|
|
|
18
|
24
|
|
|
24
|
|
16738
|
use DBIx::QuickORM::Row::Async(); |
|
|
24
|
|
|
|
|
91
|
|
|
|
24
|
|
|
|
|
764
|
|
|
19
|
24
|
|
|
24
|
|
22550
|
use DBIx::QuickORM::Iterator(); |
|
|
24
|
|
|
|
|
108
|
|
|
|
24
|
|
|
|
|
1110
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new; |
|
22
|
24
|
|
|
24
|
|
201
|
use Role::Tiny::With qw/with/; |
|
|
24
|
|
|
|
|
64
|
|
|
|
24
|
|
|
|
|
2365
|
|
|
23
|
|
|
|
|
|
|
with 'DBIx::QuickORM::Role::Handle'; |
|
24
|
|
|
|
|
|
|
|
|
25
|
24
|
|
|
|
|
174
|
use DBIx::QuickORM::Util::HashBase qw{ |
|
26
|
|
|
|
|
|
|
+connection |
|
27
|
|
|
|
|
|
|
+source |
|
28
|
|
|
|
|
|
|
+sql_builder |
|
29
|
|
|
|
|
|
|
+sql_builder_cache |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
+row |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
+where |
|
34
|
|
|
|
|
|
|
+order_by |
|
35
|
|
|
|
|
|
|
+limit |
|
36
|
|
|
|
|
|
|
+fields |
|
37
|
|
|
|
|
|
|
+omit |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
+async |
|
40
|
|
|
|
|
|
|
+aside |
|
41
|
|
|
|
|
|
|
+forked |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
+auto_refresh |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
+data_only |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
+internal_transactions |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
+target |
|
50
|
24
|
|
|
24
|
|
220
|
}; |
|
|
24
|
|
|
|
|
56
|
|
|
51
|
|
|
|
|
|
|
|
|
52
|
479
|
|
|
479
|
1
|
3218
|
sub dialect { $_[0]->{+CONNECTION}->dialect } |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
######################################## |
|
55
|
|
|
|
|
|
|
# {{{ Initialization and normalization # |
|
56
|
|
|
|
|
|
|
######################################## |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub init { |
|
59
|
252
|
|
|
252
|
0
|
497
|
my $self = shift; |
|
60
|
|
|
|
|
|
|
|
|
61
|
252
|
|
|
|
|
677
|
delete $self->{+SQL_BUILDER_CACHE}; |
|
62
|
|
|
|
|
|
|
|
|
63
|
252
|
50
|
|
|
|
730
|
croak "async, aside, and forked are exclusive options, only one may be selected" if 1 < grep { $_ } @{$self}{ASYNC(), ASIDE(), FORKED()}; |
|
|
756
|
|
|
|
|
1806
|
|
|
|
252
|
|
|
|
|
954
|
|
|
64
|
|
|
|
|
|
|
|
|
65
|
252
|
50
|
|
|
|
1070
|
my $con = $self->connection or confess "'connection' is a required attribute"; |
|
66
|
252
|
50
|
33
|
|
|
2224
|
confess "Connection '$con' is not an instance of 'DBIx::QuickORM::Connection'" |
|
67
|
|
|
|
|
|
|
unless blessed($con) && $con->isa('DBIx::QuickORM::Connection'); |
|
68
|
|
|
|
|
|
|
|
|
69
|
252
|
50
|
|
|
|
914
|
my $source = $self->{+SOURCE} or croak "No source provided"; |
|
70
|
252
|
50
|
33
|
|
|
1700
|
confess "Source '$source' does not implement the 'DBIx::QuickORM::Role::Source' role" |
|
71
|
|
|
|
|
|
|
unless blessed($source) && $source->DOES('DBIx::QuickORM::Role::Source'); |
|
72
|
|
|
|
|
|
|
|
|
73
|
252
|
|
50
|
|
|
10931
|
$self->{+INTERNAL_TRANSACTIONS} //= $con->default_internal_txn // 1; |
|
|
|
|
66
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
|
75
|
252
|
50
|
|
|
|
923
|
if (my $builder = $self->{+SQL_BUILDER}) { |
|
76
|
0
|
0
|
0
|
|
|
0
|
confess "SQL Builder '$builder' does not implement the 'DBIx::QuickORM::Role::SQLBuilder' role" |
|
77
|
|
|
|
|
|
|
unless blessed($builder) && $builder->DOES('DBIx::QuickORM::Role::SQLBuilder'); |
|
78
|
|
|
|
|
|
|
} |
|
79
|
|
|
|
|
|
|
|
|
80
|
252
|
100
|
|
|
|
852
|
if (my $row = $self->{+ROW}) { |
|
81
|
26
|
50
|
33
|
|
|
224
|
croak "Invalid row: $row" if $row && !$row->DOES('DBIx::QuickORM::Role::Row'); |
|
82
|
|
|
|
|
|
|
|
|
83
|
26
|
50
|
|
|
|
482
|
croak "You cannot provide both a 'row' and a 'where'" if $self->{+WHERE}; |
|
84
|
|
|
|
|
|
|
|
|
85
|
26
|
100
|
|
|
|
99
|
$self->{+WHERE} = $self->sql_builder->qorm_where_for_row($row) if $self->_has_pk; |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
|
|
88
|
252
|
100
|
100
|
|
|
1018
|
if ($self->_has_pk && !$self->{+WHERE}) { |
|
89
|
142
|
50
|
|
|
|
17803
|
croak "You must provide a where clause or row before specifying a limit" if $self->{+LIMIT}; |
|
90
|
142
|
50
|
|
|
|
502
|
croak "You must provide a where clause or row before specifying an order_by" if $self->{+ORDER_BY}; |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
|
|
93
|
252
|
|
66
|
|
|
1387
|
my $fields = $self->{+FIELDS} //= $source->fields_to_fetch; |
|
94
|
|
|
|
|
|
|
|
|
95
|
252
|
50
|
|
|
|
1116
|
if (my $omit = $self->{+OMIT}) { |
|
96
|
0
|
0
|
|
|
|
0
|
croak "Cannot mix 'omit' and a non-arrayref field specification ('$fields')" if ref($fields) ne 'ARRAY'; |
|
97
|
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
0
|
my $pk_fields = $source->primary_key; |
|
99
|
0
|
0
|
|
|
|
0
|
if ($omit = $self->_normalize_omit($self->{+OMIT}, $pk_fields)) { |
|
100
|
0
|
0
|
0
|
|
|
0
|
if ($pk_fields || $omit) { |
|
101
|
0
|
|
|
|
|
0
|
my %seen; |
|
102
|
0
|
|
0
|
|
|
0
|
$fields = [grep { !$seen{$_}++ && !($omit && $omit->{$_}) } @{$pk_fields // []}, @$fields]; |
|
|
0
|
|
0
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
103
|
|
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
0
|
$self->{+FIELDS} = $fields; |
|
106
|
|
|
|
|
|
|
|
|
107
|
0
|
0
|
|
|
|
0
|
if ($omit) { $self->{+OMIT} = $omit } |
|
|
0
|
|
|
|
|
0
|
|
|
108
|
0
|
|
|
|
|
0
|
else { delete $self->{+OMIT} } |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
} |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub _normalize_omit { |
|
114
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
115
|
0
|
|
|
|
|
0
|
my ($omit, $pk_fields) = @_; |
|
116
|
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
0
|
return undef unless defined $omit; |
|
118
|
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
0
|
my $r = ref($omit); |
|
120
|
|
|
|
|
|
|
#<<< |
|
121
|
0
|
0
|
|
|
|
0
|
if ($r eq 'HASH') { } # Do nothing |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
0
|
elsif ($r eq 'ARRAY') { $omit = map { ($_ => 1) } @$omit } # Turn list into hash |
|
|
0
|
|
|
|
|
0
|
|
|
123
|
0
|
|
|
|
|
0
|
elsif (!$r) { $omit = {$omit => 1} } # Turn single into hash |
|
124
|
0
|
|
|
|
|
0
|
else { croak "$omit is not a valid 'omit' value" } # oops |
|
125
|
|
|
|
|
|
|
#>>> |
|
126
|
|
|
|
|
|
|
|
|
127
|
0
|
0
|
0
|
|
|
0
|
$pk_fields //= $self->{+SOURCE}->primary_key or return $omit; |
|
128
|
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
0
|
for my $field (@$pk_fields) { |
|
130
|
0
|
0
|
|
|
|
0
|
next unless $omit->{$field}; |
|
131
|
0
|
|
|
|
|
0
|
croak "Cannot omit primary key field '$field'"; |
|
132
|
|
|
|
|
|
|
} |
|
133
|
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
0
|
return $omit; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub _sql_builder { |
|
138
|
166
|
|
|
166
|
|
398
|
my $self = shift; |
|
139
|
|
|
|
|
|
|
|
|
140
|
166
|
100
|
|
|
|
684
|
if (my $where = $self->{+WHERE}) { |
|
141
|
55
|
50
|
33
|
|
|
284
|
return $where->sql_builder if blessed($where) && $where->can('sql_builder'); |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
|
|
144
|
166
|
|
|
|
|
2544
|
return $self->{+CONNECTION}->default_sql_builder; |
|
145
|
|
|
|
|
|
|
} |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
######################################## |
|
148
|
|
|
|
|
|
|
# }}} Initialization and normalization # |
|
149
|
|
|
|
|
|
|
######################################## |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
############### |
|
152
|
|
|
|
|
|
|
# {{{ Joining # |
|
153
|
|
|
|
|
|
|
############### |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
{ |
|
156
|
24
|
|
|
24
|
|
225
|
no warnings 'once'; |
|
|
24
|
|
|
|
|
59
|
|
|
|
24
|
|
|
|
|
117696
|
|
|
157
|
|
|
|
|
|
|
*join = \&_join; |
|
158
|
|
|
|
|
|
|
} |
|
159
|
3
|
|
|
3
|
1
|
13
|
sub left_join { shift->_join(@_, type => 'LEFT') } |
|
160
|
0
|
|
|
0
|
1
|
0
|
sub right_join { shift->_join(@_, type => 'RIGHT') } |
|
161
|
0
|
|
|
0
|
1
|
0
|
sub inner_join { shift->_join(@_, type => 'INNER') } |
|
162
|
0
|
|
|
0
|
1
|
0
|
sub full_join { shift->_join(@_, type => 'FULL') } |
|
163
|
0
|
|
|
0
|
1
|
0
|
sub cross_join { shift->_join(@_, type => 'CROSS') } |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub _join { |
|
166
|
5
|
|
|
5
|
|
10
|
my $self = shift; |
|
167
|
5
|
|
|
|
|
23
|
my ($link, %params) = @_; |
|
168
|
|
|
|
|
|
|
|
|
169
|
5
|
100
|
66
|
|
|
56
|
($params{from}, $link) = ($1, $2) if !ref($link) && $link =~ m/^(.+)\:(.+)$/; |
|
170
|
|
|
|
|
|
|
|
|
171
|
5
|
|
|
|
|
8066
|
my $source = $self->{+SOURCE}; |
|
172
|
|
|
|
|
|
|
|
|
173
|
5
|
|
|
|
|
36
|
$link = $source->resolve_link($link, %params); |
|
174
|
|
|
|
|
|
|
|
|
175
|
5
|
|
|
|
|
11
|
my $join; |
|
176
|
5
|
100
|
|
|
|
38
|
if ($source->isa('DBIx::QuickORM::Join')) { |
|
177
|
3
|
|
|
|
|
27
|
$join = $source; |
|
178
|
|
|
|
|
|
|
} |
|
179
|
|
|
|
|
|
|
else { |
|
180
|
2
|
|
|
|
|
6112
|
require DBIx::QuickORM::Join; |
|
181
|
|
|
|
|
|
|
$join = DBIx::QuickORM::Join->new( |
|
182
|
|
|
|
|
|
|
primary_source => $source, |
|
183
|
2
|
|
|
|
|
27
|
schema => $self->{+CONNECTION}->schema, |
|
184
|
|
|
|
|
|
|
); |
|
185
|
|
|
|
|
|
|
} |
|
186
|
|
|
|
|
|
|
|
|
187
|
5
|
|
|
|
|
26
|
$join = $join->join(%params, link => $link); |
|
188
|
|
|
|
|
|
|
|
|
189
|
5
|
|
|
|
|
24
|
return $self->clone(SOURCE() => $join, FIELDS() => $join->fields_to_fetch); |
|
190
|
|
|
|
|
|
|
} |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
############### |
|
193
|
|
|
|
|
|
|
# }}} Joining # |
|
194
|
|
|
|
|
|
|
############### |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
################## |
|
197
|
|
|
|
|
|
|
# {{{ Immutators # |
|
198
|
|
|
|
|
|
|
################## |
|
199
|
|
|
|
|
|
|
|
|
200
|
0
|
|
|
0
|
1
|
0
|
sub new { shift->handle(@_) } |
|
201
|
|
|
|
|
|
|
|
|
202
|
156
|
|
|
156
|
1
|
787
|
sub clone { shift->handle(@_) } |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub handle { |
|
205
|
252
|
|
|
252
|
1
|
624
|
my $in = shift; |
|
206
|
|
|
|
|
|
|
|
|
207
|
252
|
|
|
|
|
714
|
my ($self, $class); |
|
208
|
252
|
100
|
|
|
|
930
|
if ($class = blessed($in)) { |
|
209
|
173
|
|
|
|
|
384
|
$self = $in; |
|
210
|
|
|
|
|
|
|
} |
|
211
|
|
|
|
|
|
|
else { |
|
212
|
79
|
|
|
|
|
194
|
$class = $in; |
|
213
|
|
|
|
|
|
|
} |
|
214
|
|
|
|
|
|
|
|
|
215
|
252
|
100
|
|
|
|
1981
|
my $clone = { $self ? %$self : () }; |
|
216
|
|
|
|
|
|
|
|
|
217
|
252
|
100
|
|
|
|
1305
|
delete $clone->{+WHERE} if $clone->{+ROW}; |
|
218
|
|
|
|
|
|
|
|
|
219
|
252
|
|
|
|
|
537
|
my %flags; |
|
220
|
252
|
|
|
0
|
|
4866
|
$flags{unknown_object} = sub { croak "Not sure what to do with '$_[1]'" }; |
|
|
0
|
|
|
|
|
0
|
|
|
221
|
252
|
|
|
0
|
|
1115
|
$flags{unknown_ref} = sub { croak "Not sure what to do with '$_[1]'" }; |
|
|
0
|
|
|
|
|
0
|
|
|
222
|
252
|
|
|
0
|
|
1112
|
$flags{unknown_arg} = sub { croak "$_[1] is not a recognized handle-attribute or table name" }; |
|
|
0
|
|
|
|
|
0
|
|
|
223
|
252
|
|
|
0
|
|
1066
|
$flags{row_and_where} = sub { croak "Cannot provide both a 'where' and a 'row'" }; |
|
|
0
|
|
|
|
|
0
|
|
|
224
|
252
|
|
|
0
|
|
1058
|
$flags{row_and_source} = sub { croak "Cannot provide both a 'source' and a 'row'" }; |
|
|
0
|
|
|
|
|
0
|
|
|
225
|
252
|
0
|
0
|
0
|
|
1753
|
$flags{bad_override} = sub { my ($self, $key, @args) = @_; croak "Handle already has a '$key' set (" . (map { defined($_) ? ( (blessed($_) && $_->can('display')) ? $_->display : "'$_'" ) : 'undef'} @args) . ")" }; |
|
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
226
|
252
|
|
|
|
|
1623
|
$flags{allow_override} = 1; |
|
227
|
|
|
|
|
|
|
|
|
228
|
252
|
|
|
|
|
603
|
my %set; |
|
229
|
252
|
|
|
|
|
1149
|
while (my $arg = shift @_) { |
|
230
|
408
|
100
|
|
|
|
1398
|
if (my $ref = ref($arg)) { |
|
231
|
17
|
50
|
|
|
|
79
|
if (my $class = blessed($arg)) { |
|
232
|
17
|
100
|
|
|
|
76
|
if ($arg->DOES('DBIx::QuickORM::Role::Source')) { |
|
233
|
13
|
50
|
33
|
|
|
276
|
$flags{bad_override}->($clone, SOURCE() => $clone->{+SOURCE}, $arg) if $clone->{+SOURCE} && !$flags{allow_override}; |
|
234
|
|
|
|
|
|
|
|
|
235
|
13
|
50
|
|
|
|
45
|
if ($set{+ROW}) { |
|
236
|
0
|
|
|
|
|
0
|
my $s1 = $arg; |
|
237
|
0
|
|
|
|
|
0
|
my $s2 = $clone->{+ROW}->source; |
|
238
|
0
|
0
|
|
|
|
0
|
$flags{row_and_source}->($clone) unless $s1 == $s2; |
|
239
|
|
|
|
|
|
|
} |
|
240
|
|
|
|
|
|
|
else { |
|
241
|
13
|
|
|
|
|
39
|
$clone->{+SOURCE} = $arg; |
|
242
|
|
|
|
|
|
|
} |
|
243
|
|
|
|
|
|
|
|
|
244
|
13
|
|
|
|
|
36
|
$set{+SOURCE}++; |
|
245
|
|
|
|
|
|
|
|
|
246
|
13
|
|
|
|
|
59
|
next; |
|
247
|
|
|
|
|
|
|
} |
|
248
|
|
|
|
|
|
|
|
|
249
|
4
|
50
|
|
|
|
307
|
if ($arg->DOES('DBIx::QuickORM::Role::SQLBuilder')) { |
|
250
|
0
|
0
|
0
|
|
|
0
|
$flags{bad_override}->($clone, SQL_BUILDER() => $clone->{+SQL_BUILDER}, $arg) if $clone->{+SQL_BUILDER} && !$flags{allow_override}; |
|
251
|
0
|
|
|
|
|
0
|
$set{+SQL_BUILDER}++; |
|
252
|
0
|
|
|
|
|
0
|
$clone->{+SQL_BUILDER} = $arg; |
|
253
|
0
|
|
|
|
|
0
|
next; |
|
254
|
|
|
|
|
|
|
} |
|
255
|
|
|
|
|
|
|
|
|
256
|
4
|
50
|
|
|
|
129
|
if ($arg->isa('DBIx::QuickORM::Connection')) { |
|
257
|
0
|
0
|
0
|
|
|
0
|
$flags{bad_override}->($clone, CONNECTION() => $clone->{+CONNECTION}, $arg) if $clone->{+CONNECTION} && !$flags{allow_override}; |
|
258
|
0
|
|
|
|
|
0
|
$set{+CONNECTION}++; |
|
259
|
0
|
|
|
|
|
0
|
$clone->{+CONNECTION} = $arg; |
|
260
|
0
|
|
|
|
|
0
|
next; |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
|
|
263
|
4
|
50
|
|
|
|
33
|
if ($arg->DOES('DBIx::QuickORM::Role::Row')) { |
|
264
|
4
|
50
|
33
|
|
|
90
|
$flags{bad_override}->($clone, ROW() => $clone->{+ROW}, $arg) if $clone->{+ROW} && !$flags{allow_override}; |
|
265
|
4
|
50
|
|
|
|
22
|
$flags{row_and_where}->($clone) if $set{+WHERE}; |
|
266
|
|
|
|
|
|
|
|
|
267
|
4
|
50
|
|
|
|
19
|
if ($set{+SOURCE}) { |
|
268
|
0
|
|
|
|
|
0
|
my $s1 = $clone->{+SOURCE}; |
|
269
|
0
|
|
|
|
|
0
|
my $s2 = $arg->source; |
|
270
|
0
|
0
|
|
|
|
0
|
$flags{row_and_source}->($clone) unless $s1 == $s2; |
|
271
|
|
|
|
|
|
|
} |
|
272
|
|
|
|
|
|
|
else { |
|
273
|
4
|
|
|
|
|
22
|
$clone->{+SOURCE} = $arg->source; |
|
274
|
|
|
|
|
|
|
} |
|
275
|
|
|
|
|
|
|
|
|
276
|
4
|
|
|
|
|
15
|
$set{+ROW}++; |
|
277
|
4
|
|
|
|
|
14
|
$clone->{+ROW} = $arg; |
|
278
|
4
|
|
|
|
|
13
|
delete $clone->{+WHERE}; |
|
279
|
4
|
|
|
|
|
24
|
next; |
|
280
|
|
|
|
|
|
|
} |
|
281
|
|
|
|
|
|
|
|
|
282
|
0
|
|
|
|
|
0
|
$flags{unknown_object}->($clone, $arg); |
|
283
|
|
|
|
|
|
|
} |
|
284
|
|
|
|
|
|
|
|
|
285
|
0
|
0
|
|
|
|
0
|
if ($ref eq 'ARRAY') { |
|
286
|
0
|
0
|
|
|
|
0
|
if (my $cb = $flags{array}) { |
|
287
|
0
|
0
|
|
|
|
0
|
$cb->($clone, $arg) and next; |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
|
|
290
|
0
|
0
|
0
|
|
|
0
|
$flags{bad_override}->($clone, ORDER_BY() => $clone->{+ORDER_BY}, $arg) if $clone->{+ORDER_BY} && !$flags{allow_override}; |
|
291
|
0
|
|
|
|
|
0
|
$clone->{+ORDER_BY} = $arg; |
|
292
|
0
|
|
|
|
|
0
|
next; |
|
293
|
|
|
|
|
|
|
} |
|
294
|
|
|
|
|
|
|
|
|
295
|
0
|
0
|
|
|
|
0
|
if ($ref eq 'HASH') { |
|
296
|
0
|
0
|
|
|
|
0
|
if (my $cb = $flags{hash}) { |
|
297
|
0
|
0
|
|
|
|
0
|
$cb->($clone, $arg) and next; |
|
298
|
|
|
|
|
|
|
} |
|
299
|
|
|
|
|
|
|
|
|
300
|
0
|
0
|
0
|
|
|
0
|
$flags{bad_override}->($clone, WHERE() => $clone->{+WHERE}, $arg) if $clone->{+WHERE} && !$flags{allow_override}; |
|
301
|
0
|
0
|
|
|
|
0
|
$flags{row_and_where}->($clone) if $set{+ROW}; |
|
302
|
0
|
|
|
|
|
0
|
$set{+WHERE}++; |
|
303
|
0
|
|
|
|
|
0
|
$clone->{+WHERE} = $arg; |
|
304
|
0
|
|
|
|
|
0
|
delete $clone->{+ROW}; |
|
305
|
0
|
|
|
|
|
0
|
next; |
|
306
|
|
|
|
|
|
|
} |
|
307
|
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
0
|
$flags{unknown_ref}->($clone, $arg); |
|
309
|
0
|
|
|
|
|
0
|
next; |
|
310
|
|
|
|
|
|
|
} |
|
311
|
|
|
|
|
|
|
|
|
312
|
391
|
50
|
|
|
|
1426
|
if ($arg =~ m/^-(.+)$/) { |
|
313
|
0
|
|
|
|
|
0
|
my $flag = $1; |
|
314
|
0
|
|
|
|
|
0
|
my $val = shift @_; |
|
315
|
0
|
|
|
|
|
0
|
$flags{$flag} = $val; |
|
316
|
0
|
0
|
|
|
|
0
|
if ($arg eq 'unknown') { |
|
317
|
0
|
|
|
|
|
0
|
$flags{$_} = $val for qw/unknown_object unknown_ref unknown_arg/; |
|
318
|
|
|
|
|
|
|
} |
|
319
|
0
|
|
|
|
|
0
|
next; |
|
320
|
|
|
|
|
|
|
} |
|
321
|
|
|
|
|
|
|
|
|
322
|
391
|
50
|
|
|
|
1588
|
if ($arg =~ m/^\d+$/) { |
|
323
|
0
|
0
|
|
|
|
0
|
if (my $cb = $flags{integer}) { |
|
324
|
0
|
0
|
|
|
|
0
|
$cb->($clone, $arg) and next; |
|
325
|
|
|
|
|
|
|
} |
|
326
|
0
|
0
|
0
|
|
|
0
|
$flags{bad_override}->($clone, LIMIT() => $clone->{+LIMIT}, $arg) if defined($clone->{+LIMIT}) && !$flags{allow_override}; |
|
327
|
0
|
|
|
|
|
0
|
$clone->{+LIMIT} = $arg; |
|
328
|
0
|
|
|
|
|
0
|
next; |
|
329
|
|
|
|
|
|
|
} |
|
330
|
|
|
|
|
|
|
|
|
331
|
391
|
50
|
|
|
|
1259
|
if (my $cb = $flags{scalar}) { |
|
332
|
0
|
0
|
|
|
|
0
|
$cb->($clone, $arg, \@_) and next; |
|
333
|
|
|
|
|
|
|
} |
|
334
|
|
|
|
|
|
|
|
|
335
|
391
|
100
|
|
|
|
4104
|
if (my $const = $class->can(uc($arg))) { |
|
336
|
335
|
|
|
|
|
768
|
my $val = shift(@_); |
|
337
|
335
|
|
|
|
|
975
|
my $key = $const->(); |
|
338
|
|
|
|
|
|
|
|
|
339
|
335
|
50
|
66
|
|
|
1379
|
$flags{bad_override}->($clone, $key => $clone->{$key}, $val) if defined($clone->{$key}) && !$flags{allow_override}; |
|
340
|
|
|
|
|
|
|
|
|
341
|
335
|
100
|
|
|
|
1266
|
unless (defined $val) { |
|
342
|
51
|
|
|
|
|
120
|
delete $set{$key}; |
|
343
|
51
|
|
|
|
|
100
|
delete $clone->{$key}; |
|
344
|
51
|
|
|
|
|
206
|
next; |
|
345
|
|
|
|
|
|
|
} |
|
346
|
|
|
|
|
|
|
|
|
347
|
284
|
|
|
|
|
803
|
$set{$key}++; |
|
348
|
284
|
50
|
66
|
|
|
971
|
$flags{row_and_where}->($clone) if $set{+ROW} && $set{+WHERE}; |
|
349
|
284
|
|
|
|
|
769
|
$clone->{$key} = $val; |
|
350
|
|
|
|
|
|
|
|
|
351
|
284
|
100
|
|
|
|
1179
|
if ($key eq WHERE()) { |
|
|
|
100
|
|
|
|
|
|
|
352
|
56
|
50
|
66
|
|
|
293
|
$flags{bad_override}->($clone, ROW() => $clone->{+ROW}, undef) if $clone->{+ROW} && !$flags{allow_override}; |
|
353
|
56
|
|
|
|
|
165
|
delete $clone->{+ROW}; |
|
354
|
|
|
|
|
|
|
} |
|
355
|
|
|
|
|
|
|
elsif ($key eq ROW()) { |
|
356
|
18
|
50
|
33
|
|
|
87
|
$flags{bad_override}->($clone, WHERE() => $clone->{+WHERE}, undef) if $clone->{+WHERE} && !$flags{allow_override}; |
|
357
|
18
|
|
|
|
|
75
|
delete $clone->{+WHERE}; |
|
358
|
|
|
|
|
|
|
} |
|
359
|
|
|
|
|
|
|
|
|
360
|
284
|
|
|
|
|
1333
|
next; |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
|
|
363
|
56
|
50
|
|
|
|
526
|
if (my $src = $clone->{+CONNECTION}->source($arg, no_fatal => 1)) { |
|
364
|
56
|
50
|
33
|
|
|
322
|
$flags{bad_override}->($clone, SOURCE() => $clone->{+SOURCE}, $src) if $clone->{+SOURCE} && !$flags{allow_override}; |
|
365
|
56
|
|
|
|
|
175
|
$clone->{+SOURCE} = $src; |
|
366
|
56
|
|
|
|
|
270
|
next; |
|
367
|
|
|
|
|
|
|
} |
|
368
|
|
|
|
|
|
|
|
|
369
|
0
|
|
|
|
|
0
|
$flags{unknown_arg}->($clone, $arg, \@_); |
|
370
|
|
|
|
|
|
|
} |
|
371
|
|
|
|
|
|
|
|
|
372
|
252
|
|
|
|
|
807
|
my $new = bless($clone, $class); |
|
373
|
252
|
|
|
|
|
1192
|
$new->init(); |
|
374
|
252
|
|
|
|
|
18628
|
return $new; |
|
375
|
|
|
|
|
|
|
} |
|
376
|
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub auto_refresh { |
|
378
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
|
379
|
1
|
50
|
|
|
|
6
|
croak "Must not be called in void context" unless defined wantarray; |
|
380
|
1
|
50
|
|
|
|
4
|
return $self if $self->{+AUTO_REFRESH}; |
|
381
|
1
|
|
|
|
|
7
|
return $self->clone(AUTO_REFRESH() => 1); |
|
382
|
|
|
|
|
|
|
} |
|
383
|
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub no_auto_refresh { |
|
385
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
386
|
0
|
0
|
|
|
|
0
|
croak "Must not be called in void context" unless defined wantarray; |
|
387
|
0
|
0
|
|
|
|
0
|
return $self unless $self->{+AUTO_REFRESH}; |
|
388
|
0
|
|
|
|
|
0
|
return $self->clone(AUTO_REFRESH() => 0); |
|
389
|
|
|
|
|
|
|
} |
|
390
|
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
sub sync { |
|
392
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
393
|
0
|
0
|
|
|
|
0
|
croak "Must not be called in void context" unless defined wantarray; |
|
394
|
0
|
0
|
0
|
|
|
0
|
return $self unless $self->{+FORKED} || $self->{+ASYNC} || $self->{+ASIDE}; |
|
|
|
|
0
|
|
|
|
|
|
395
|
0
|
|
|
|
|
0
|
return $self->clone(FORKED() => 0, ASYNC() => 0, ASIDE() => 0); |
|
396
|
|
|
|
|
|
|
} |
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub async { |
|
399
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
400
|
0
|
0
|
|
|
|
0
|
croak "Must not be called in void context" unless defined wantarray; |
|
401
|
0
|
0
|
|
|
|
0
|
return $self if $self->{+ASYNC}; |
|
402
|
0
|
|
|
|
|
0
|
return $self->clone(FORKED() => 0, ASYNC() => 1, ASIDE() => 0); |
|
403
|
|
|
|
|
|
|
} |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub aside { |
|
406
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
407
|
0
|
0
|
|
|
|
0
|
croak "Must not be called in void context" unless defined wantarray; |
|
408
|
0
|
0
|
|
|
|
0
|
return $self if $self->{+ASIDE}; |
|
409
|
0
|
|
|
|
|
0
|
return $self->clone(FORKED() => 0, ASYNC() => 0, ASIDE() => 1); |
|
410
|
|
|
|
|
|
|
} |
|
411
|
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
sub forked { |
|
413
|
5
|
|
|
5
|
1
|
18
|
my $self = shift; |
|
414
|
5
|
50
|
|
|
|
24
|
croak "Must not be called in void context" unless defined wantarray; |
|
415
|
5
|
50
|
|
|
|
22
|
return $self if $self->{+FORKED}; |
|
416
|
5
|
|
|
|
|
71
|
return $self->clone(FORKED() => 1, ASYNC() => 0, ASIDE() => 0); |
|
417
|
|
|
|
|
|
|
} |
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub data_only { |
|
420
|
6
|
|
|
6
|
1
|
1031
|
my $self = shift; |
|
421
|
6
|
50
|
|
|
|
35
|
croak "Must not be called in void context" unless defined wantarray; |
|
422
|
|
|
|
|
|
|
|
|
423
|
6
|
50
|
|
|
|
28
|
if (@_) { |
|
424
|
0
|
|
|
|
|
0
|
my ($val) = @_; |
|
425
|
0
|
|
|
|
|
0
|
return $self->clone(DATA_ONLY() => $val); |
|
426
|
|
|
|
|
|
|
} |
|
427
|
|
|
|
|
|
|
|
|
428
|
6
|
50
|
|
|
|
31
|
return $self if $self->{+DATA_ONLY}; |
|
429
|
|
|
|
|
|
|
|
|
430
|
6
|
|
|
|
|
37
|
return $self->clone(DATA_ONLY() => 1); |
|
431
|
|
|
|
|
|
|
} |
|
432
|
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub all_fields { |
|
434
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
435
|
0
|
0
|
|
|
|
0
|
croak "Must not be called in void context" unless defined wantarray; |
|
436
|
0
|
|
|
|
|
0
|
return $self->clone(FIELDS() => $self->{+SOURCE}->fields_list_all); |
|
437
|
|
|
|
|
|
|
} |
|
438
|
|
|
|
|
|
|
|
|
439
|
0
|
|
0
|
0
|
1
|
0
|
sub internal_txns { $_[0]->{+INTERNAL_TRANSACTIONS} = $_[1] // 1; $_[0] } |
|
|
0
|
|
|
|
|
0
|
|
|
440
|
0
|
|
0
|
0
|
1
|
0
|
sub internal_transactions { $_[0]->{+INTERNAL_TRANSACTIONS} = $_[1] // 1; $_[0] } |
|
|
0
|
|
|
|
|
0
|
|
|
441
|
|
|
|
|
|
|
|
|
442
|
0
|
0
|
|
0
|
1
|
0
|
sub no_internal_txns { $_[0]->{+INTERNAL_TRANSACTIONS} = defined($_[1]) ? $_[1] ? 0 : 1 : 0; $_[0] } |
|
|
0
|
0
|
|
|
|
0
|
|
|
443
|
0
|
0
|
|
0
|
1
|
0
|
sub no_internal_transactions { $_[0]->{+INTERNAL_TRANSACTIONS} = defined($_[1]) ? $_[1] ? 0 : 1 : 0; $_[0] } |
|
|
0
|
0
|
|
|
|
0
|
|
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# Do these last to avoid conflicts with the operators |
|
446
|
|
|
|
|
|
|
{ |
|
447
|
24
|
|
|
24
|
|
295
|
no warnings 'once'; |
|
|
24
|
|
|
|
|
59
|
|
|
|
24
|
|
|
|
|
290428
|
|
|
448
|
|
|
|
|
|
|
*and = set_subname 'and' => sub { |
|
449
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
450
|
0
|
|
|
|
|
0
|
return $self->clone(WHERE() => $self->sql_builder->qorm_and($self->{+WHERE}, @_)); |
|
451
|
|
|
|
|
|
|
}; |
|
452
|
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
*or = set_subname 'or' => sub { |
|
454
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
455
|
0
|
|
|
|
|
0
|
return $self->clone(WHERE() => $self->sql_builder->qorm_or($self->{+WHERE}, @_)); |
|
456
|
|
|
|
|
|
|
}; |
|
457
|
|
|
|
|
|
|
} |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
################## |
|
460
|
|
|
|
|
|
|
# }}} Immutators # |
|
461
|
|
|
|
|
|
|
################## |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
################### |
|
464
|
|
|
|
|
|
|
# {{{ Immucessors # |
|
465
|
|
|
|
|
|
|
################### |
|
466
|
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub sql_builder { |
|
468
|
184
|
|
|
184
|
1
|
445
|
my $self = shift; |
|
469
|
184
|
50
|
|
|
|
3729
|
croak "Must not be called in void context" unless defined wantarray; |
|
470
|
|
|
|
|
|
|
|
|
471
|
184
|
50
|
|
|
|
552
|
return $self->clone(SQL_BUILDER() => $_[0]) if @_; |
|
472
|
|
|
|
|
|
|
|
|
473
|
184
|
50
|
|
|
|
667
|
return $self->{+SQL_BUILDER} if $self->{+SQL_BUILDER}; # Directly set |
|
474
|
184
|
|
66
|
|
|
1314
|
return $self->{+SQL_BUILDER_CACHE} //= $self->_sql_builder; |
|
475
|
|
|
|
|
|
|
} |
|
476
|
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub connection { |
|
478
|
256
|
|
|
256
|
1
|
1838
|
my $self = shift; |
|
479
|
256
|
50
|
|
|
|
750
|
croak "Must not be called in void context" unless defined wantarray; |
|
480
|
256
|
50
|
|
|
|
1512
|
return $self->{+CONNECTION} unless @_; |
|
481
|
0
|
|
|
|
|
0
|
return $self->clone(CONNECTION() => $_[0]); |
|
482
|
|
|
|
|
|
|
} |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
sub source { |
|
485
|
3
|
|
|
3
|
1
|
9
|
my $self = shift; |
|
486
|
3
|
50
|
|
|
|
12
|
croak "Must not be called in void context" unless defined wantarray; |
|
487
|
3
|
50
|
|
|
|
25
|
return $self->{+SOURCE} unless @_; |
|
488
|
0
|
|
|
|
|
0
|
return $self->clone(SOURCE() => $_[0]); |
|
489
|
|
|
|
|
|
|
} |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub row { |
|
492
|
12
|
|
|
12
|
1
|
313
|
my $self = shift; |
|
493
|
12
|
50
|
|
|
|
40
|
croak "Must not be called in void context" unless defined wantarray; |
|
494
|
12
|
50
|
|
|
|
39
|
return $self->{+ROW} unless @_; |
|
495
|
12
|
|
|
|
|
76
|
return $self->clone(ROW() => $_[0], WHERE() => undef); |
|
496
|
|
|
|
|
|
|
} |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
sub fields { |
|
499
|
167
|
|
|
167
|
1
|
4443
|
my $self = shift; |
|
500
|
167
|
50
|
|
|
|
661
|
croak "Must not be called in void context" unless defined wantarray; |
|
501
|
167
|
100
|
|
|
|
960
|
return $self->{+FIELDS} unless @_; |
|
502
|
|
|
|
|
|
|
|
|
503
|
7
|
50
|
33
|
|
|
84
|
return $self->clone(FIELDS() => $_[0]) if @_ == 1 && ref($_[0]) eq 'ARRAY'; |
|
504
|
|
|
|
|
|
|
|
|
505
|
0
|
|
0
|
|
|
0
|
my @fields = @{$self->{+FIELDS} // $self->{+SOURCE}->fields_to_fetch}; |
|
|
0
|
|
|
|
|
0
|
|
|
506
|
0
|
|
|
|
|
0
|
push @fields => @_; |
|
507
|
|
|
|
|
|
|
|
|
508
|
0
|
|
|
|
|
0
|
return $self->clone(FIELDS() => \@fields); |
|
509
|
|
|
|
|
|
|
} |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub omit { |
|
512
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
513
|
0
|
0
|
|
|
|
0
|
croak "Must not be called in void context" unless defined wantarray; |
|
514
|
0
|
0
|
|
|
|
0
|
return $self->{+OMIT} unless @_; |
|
515
|
|
|
|
|
|
|
|
|
516
|
0
|
0
|
0
|
|
|
0
|
return $self->clone(OMIT() => $_[0]) if @_ == 1 && ref($_[0]) eq 'ARRAY'; |
|
517
|
|
|
|
|
|
|
|
|
518
|
0
|
|
0
|
|
|
0
|
my @omit = @{$self->{+OMIT} // []}; |
|
|
0
|
|
|
|
|
0
|
|
|
519
|
0
|
|
|
|
|
0
|
push @omit => @_; |
|
520
|
0
|
|
|
|
|
0
|
return $self->clone(OMIT() => \@omit) |
|
521
|
|
|
|
|
|
|
} |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
sub limit { |
|
524
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
525
|
0
|
0
|
|
|
|
0
|
croak "Must not be called in void context" unless defined wantarray; |
|
526
|
0
|
0
|
|
|
|
0
|
return $self->{+LIMIT} unless @_; |
|
527
|
0
|
|
|
|
|
0
|
return $self->clone(LIMIT() => $_[0]); |
|
528
|
|
|
|
|
|
|
} |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
sub where { |
|
531
|
39
|
|
|
39
|
1
|
101
|
my $self = shift; |
|
532
|
39
|
50
|
|
|
|
152
|
croak "Must not be called in void context" unless defined wantarray; |
|
533
|
39
|
50
|
|
|
|
150
|
return $self->{+WHERE} unless @_; |
|
534
|
39
|
|
|
|
|
4331
|
return $self->clone(WHERE() => $_[0], ROW() => undef); |
|
535
|
|
|
|
|
|
|
} |
|
536
|
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
sub target { |
|
538
|
78
|
|
|
78
|
0
|
193
|
my $self = shift; |
|
539
|
78
|
50
|
|
|
|
334
|
croak "Must not be called in void context" unless defined wantarray; |
|
540
|
78
|
50
|
|
|
|
317
|
return $self->{+TARGET} unless @_; |
|
541
|
78
|
|
|
|
|
582
|
return $self->clone(TARGET() => $_[0]); |
|
542
|
|
|
|
|
|
|
} |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
sub order_by { |
|
545
|
3
|
|
|
3
|
1
|
15
|
my $self = shift; |
|
546
|
3
|
50
|
|
|
|
19
|
croak "Must not be called in void context" unless defined wantarray; |
|
547
|
3
|
50
|
|
|
|
11
|
return $self->{+ORDER_BY} unless @_; |
|
548
|
3
|
100
|
|
|
|
23
|
return $self->clone(ORDER_BY() => @_ > 1 ? [@_] : $_[0]); |
|
549
|
|
|
|
|
|
|
} |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
################### |
|
552
|
|
|
|
|
|
|
# }}} Immucessors # |
|
553
|
|
|
|
|
|
|
################### |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
####################### |
|
556
|
|
|
|
|
|
|
# {{{ State Accessors # |
|
557
|
|
|
|
|
|
|
####################### |
|
558
|
|
|
|
|
|
|
|
|
559
|
97
|
|
33
|
97
|
1
|
961
|
sub is_sync { !($_[0]->{+FORKED} || $_[0]->{+ASYNC} || $_[0]->{+ASIDE}) } |
|
560
|
0
|
|
|
0
|
1
|
0
|
sub is_async { $_[0]->{+ASYNC} } |
|
561
|
0
|
|
|
0
|
1
|
0
|
sub is_aside { $_[0]->{+ASIDE} } |
|
562
|
0
|
|
|
0
|
1
|
0
|
sub is_forked { $_[0]->{+FORKED} } |
|
563
|
0
|
0
|
|
0
|
1
|
0
|
sub using_internal_transactions { $_[0]->{+INTERNAL_TRANSACTIONS} ? 1 : 0 } |
|
564
|
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
####################### |
|
566
|
|
|
|
|
|
|
# }}} State Accessors # |
|
567
|
|
|
|
|
|
|
####################### |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
#################### |
|
570
|
|
|
|
|
|
|
# {{{ STH BUILDERS # |
|
571
|
|
|
|
|
|
|
#################### |
|
572
|
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
sub _has_pk { |
|
574
|
375
|
|
|
375
|
|
757
|
my $self = shift; |
|
575
|
375
|
|
|
|
|
2036
|
my $pk_fields = $self->{+SOURCE}->primary_key; |
|
576
|
375
|
|
66
|
|
|
1462
|
my $has_pk = $pk_fields && @$pk_fields; |
|
577
|
375
|
100
|
|
|
|
4226
|
return $has_pk ? $pk_fields : 0; |
|
578
|
|
|
|
|
|
|
} |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
sub _make_sth { |
|
581
|
160
|
|
|
160
|
|
554
|
my $self = shift; |
|
582
|
160
|
|
|
|
|
5919
|
my ($sql, %params) = @_; |
|
583
|
|
|
|
|
|
|
|
|
584
|
160
|
0
|
33
|
|
|
666
|
croak "'on_ready' or 'no_rows' is required" unless $params{on_ready} || $params{no_rows}; |
|
585
|
|
|
|
|
|
|
|
|
586
|
160
|
|
|
|
|
1274
|
$self->{+CONNECTION}->pid_and_async_check; |
|
587
|
|
|
|
|
|
|
|
|
588
|
160
|
50
|
33
|
|
|
1257
|
return $self->_make_async_sth($sql, %params) if $self->{+ASYNC} || $self->{+ASIDE}; |
|
589
|
160
|
100
|
|
|
|
616
|
return $self->_make_forked_sth($sql, %params) if $self->{+FORKED}; |
|
590
|
155
|
|
|
|
|
9975
|
return $self->_make_sync_sth($sql, %params); |
|
591
|
|
|
|
|
|
|
} |
|
592
|
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub _execute { |
|
594
|
157
|
|
|
157
|
|
369
|
my $self = shift; |
|
595
|
157
|
|
|
|
|
496
|
my ($dbh, $sql, @prepare_args) = @_; |
|
596
|
157
|
|
|
|
|
2730
|
my $sth = $dbh->prepare($sql->{statement}, @prepare_args); |
|
597
|
156
|
|
|
|
|
32279
|
$self->_do_binds($sth, $sql); |
|
598
|
155
|
|
|
|
|
447315
|
my $res = $sth->execute(); |
|
599
|
155
|
|
|
|
|
1363
|
return ($sth, $res); |
|
600
|
|
|
|
|
|
|
} |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
sub _do_binds { |
|
603
|
156
|
|
|
156
|
|
384
|
my $self = shift; |
|
604
|
156
|
|
|
|
|
4479
|
my ($sth, $sql) = @_; |
|
605
|
|
|
|
|
|
|
|
|
606
|
156
|
|
|
|
|
480
|
my $bind = $sql->{bind}; |
|
607
|
156
|
|
|
|
|
447
|
my $source = $sql->{+SOURCE}; |
|
608
|
156
|
|
|
|
|
626
|
my $dialect = $self->dialect; |
|
609
|
156
|
|
|
|
|
1236
|
my $quote_bin = $dialect->quote_binary_data; |
|
610
|
|
|
|
|
|
|
|
|
611
|
156
|
|
|
|
|
583
|
for my $item (@$bind) { |
|
612
|
189
|
|
|
|
|
442
|
my ($field, $val, $param, $type) = @{$item}{qw/field value param type/}; |
|
|
189
|
|
|
|
|
894
|
|
|
613
|
|
|
|
|
|
|
|
|
614
|
189
|
|
|
|
|
392
|
my @args; |
|
615
|
189
|
50
|
|
|
|
737
|
if ($type eq 'field') { |
|
616
|
189
|
|
|
|
|
1113
|
my $affinity = $source->field_affinity($field, $dialect); |
|
617
|
189
|
|
|
|
|
1211
|
my %conflate_args = ( |
|
618
|
|
|
|
|
|
|
affinity => $affinity, |
|
619
|
|
|
|
|
|
|
field => $field, |
|
620
|
|
|
|
|
|
|
dialect => $dialect, |
|
621
|
|
|
|
|
|
|
source => $source, |
|
622
|
|
|
|
|
|
|
value => $val, |
|
623
|
|
|
|
|
|
|
); |
|
624
|
|
|
|
|
|
|
|
|
625
|
189
|
50
|
33
|
|
|
1258
|
if (blessed($val) && $val->DOES('DBIx::QuickORM::Role::Type')) { |
|
|
|
100
|
|
|
|
|
|
|
626
|
0
|
|
|
|
|
0
|
$val = $val->qorm_deflate(%conflate_args); |
|
627
|
|
|
|
|
|
|
} |
|
628
|
|
|
|
|
|
|
elsif (my $type = $source->field_type($field)) { |
|
629
|
22
|
|
|
|
|
6335
|
$val = $type->qorm_deflate(%conflate_args); |
|
630
|
|
|
|
|
|
|
} |
|
631
|
|
|
|
|
|
|
|
|
632
|
188
|
100
|
66
|
|
|
2570
|
if ($quote_bin && $affinity eq 'binary') { |
|
633
|
4
|
|
|
|
|
12
|
@args = ($quote_bin); |
|
634
|
|
|
|
|
|
|
} |
|
635
|
|
|
|
|
|
|
} |
|
636
|
|
|
|
|
|
|
|
|
637
|
188
|
|
|
|
|
2019
|
$sth->bind_param($param, $val, @args); |
|
638
|
|
|
|
|
|
|
} |
|
639
|
|
|
|
|
|
|
|
|
640
|
155
|
|
|
|
|
531
|
return $sth; |
|
641
|
|
|
|
|
|
|
} |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub _make_sync_sth { |
|
644
|
155
|
|
|
155
|
|
382
|
my $self = shift; |
|
645
|
155
|
|
|
|
|
616
|
my ($sql, %params) = @_; |
|
646
|
|
|
|
|
|
|
|
|
647
|
155
|
|
|
|
|
463
|
my $con = $self->{+CONNECTION}; |
|
648
|
155
|
|
|
|
|
669
|
my $dbh = $con->dbh; |
|
649
|
155
|
|
|
|
|
669
|
my ($sth, $res) = $self->_execute($dbh, $sql); |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
return DBIx::QuickORM::STH->new( |
|
652
|
|
|
|
|
|
|
%params, |
|
653
|
|
|
|
|
|
|
connection => $con, |
|
654
|
153
|
|
|
|
|
6889
|
source => $sql->{+SOURCE}, |
|
655
|
|
|
|
|
|
|
dbh => $dbh, |
|
656
|
|
|
|
|
|
|
sth => $sth, |
|
657
|
|
|
|
|
|
|
sql => $sql, |
|
658
|
|
|
|
|
|
|
result => $res, |
|
659
|
|
|
|
|
|
|
); |
|
660
|
|
|
|
|
|
|
} |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub _make_async_sth { |
|
663
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
664
|
0
|
|
|
|
|
0
|
my ($sql, %params) = @_; |
|
665
|
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
0
|
my $dialect = $self->dialect; |
|
667
|
0
|
0
|
|
|
|
0
|
croak "Dialect '" . $dialect->dialect_name . "' does not support async" unless $dialect->async_supported; |
|
668
|
|
|
|
|
|
|
|
|
669
|
0
|
|
|
|
|
0
|
my $con = $self->{+CONNECTION}; |
|
670
|
|
|
|
|
|
|
|
|
671
|
0
|
|
|
|
|
0
|
my ($dbh, $class, $meth); |
|
672
|
0
|
0
|
|
|
|
0
|
if ($self->{+ASIDE}) { |
|
673
|
0
|
|
|
|
|
0
|
$meth = 'add_aside'; |
|
674
|
0
|
|
|
|
|
0
|
$dbh = $con->aside_dbh; |
|
675
|
0
|
|
|
|
|
0
|
$class = 'DBIx::QuickORM::STH::Aside'; |
|
676
|
|
|
|
|
|
|
} |
|
677
|
|
|
|
|
|
|
else { |
|
678
|
0
|
|
|
|
|
0
|
$meth = 'set_async'; |
|
679
|
0
|
|
|
|
|
0
|
$dbh = $con->dbh; |
|
680
|
0
|
|
|
|
|
0
|
$class = 'DBIx::QuickORM::STH::Async'; |
|
681
|
|
|
|
|
|
|
} |
|
682
|
|
|
|
|
|
|
|
|
683
|
0
|
|
|
|
|
0
|
my ($sth, $res) = $self->_execute($dbh, $sql, {$dialect->async_prepare_args}); |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
my $out = $class->new( |
|
686
|
|
|
|
|
|
|
%params, |
|
687
|
|
|
|
|
|
|
connection => $con, |
|
688
|
0
|
|
|
|
|
0
|
source => $sql->{+SOURCE}, |
|
689
|
|
|
|
|
|
|
dbh => $dbh, |
|
690
|
|
|
|
|
|
|
sth => $sth, |
|
691
|
|
|
|
|
|
|
sql => $sql, |
|
692
|
|
|
|
|
|
|
async_result => $res, |
|
693
|
|
|
|
|
|
|
); |
|
694
|
|
|
|
|
|
|
|
|
695
|
0
|
|
|
|
|
0
|
$con->$meth($out); |
|
696
|
0
|
|
|
|
|
0
|
return $out; |
|
697
|
|
|
|
|
|
|
} |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
sub _make_forked_sth { |
|
700
|
5
|
|
|
5
|
|
13
|
my $self = shift; |
|
701
|
5
|
|
|
|
|
19
|
my ($sql, %params) = @_; |
|
702
|
|
|
|
|
|
|
|
|
703
|
5
|
|
|
|
|
17
|
my $con = $self->{+CONNECTION}; |
|
704
|
|
|
|
|
|
|
|
|
705
|
5
|
|
|
|
|
9
|
my ($rh, $wh); |
|
706
|
5
|
50
|
|
|
|
283
|
pipe($rh, $wh) or die "Could not create pipe: $!"; |
|
707
|
5
|
|
50
|
|
|
31964
|
my $pid = fork // die "Could not fork: $!"; |
|
708
|
|
|
|
|
|
|
|
|
709
|
5
|
50
|
|
|
|
327
|
if ($pid) { # Parent |
|
710
|
5
|
|
|
|
|
379
|
close($wh); |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
my $fork = DBIx::QuickORM::STH::Fork->new( |
|
713
|
|
|
|
|
|
|
%params, |
|
714
|
|
|
|
|
|
|
connection => $con, |
|
715
|
5
|
|
|
|
|
1327
|
source => $sql->{+SOURCE}, |
|
716
|
|
|
|
|
|
|
pid => $pid, |
|
717
|
|
|
|
|
|
|
sql => $sql, |
|
718
|
|
|
|
|
|
|
pipe => $rh, |
|
719
|
|
|
|
|
|
|
); |
|
720
|
|
|
|
|
|
|
|
|
721
|
5
|
|
|
|
|
225
|
$con->add_fork($fork); |
|
722
|
|
|
|
|
|
|
|
|
723
|
5
|
|
|
|
|
1689
|
return $fork; |
|
724
|
|
|
|
|
|
|
} |
|
725
|
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
# Child |
|
727
|
|
|
|
|
|
|
my $guard = Scope::Guard->new(sub { |
|
728
|
0
|
|
|
0
|
|
0
|
my @caller = caller; |
|
729
|
0
|
|
|
|
|
0
|
print STDERR "Escaped Scope in forked query at $caller[1] line $caller[2].\n"; |
|
730
|
0
|
|
|
|
|
0
|
POSIX::_exit(255); |
|
731
|
0
|
|
|
|
|
0
|
}); |
|
732
|
0
|
|
|
|
|
0
|
close($rh); |
|
733
|
|
|
|
|
|
|
|
|
734
|
0
|
|
|
|
|
0
|
my $json = Cpanel::JSON::XS->new->utf8(1)->convert_blessed(1)->allow_nonref(1); |
|
735
|
0
|
|
|
|
|
0
|
my $dbh = $con->aside_dbh; |
|
736
|
|
|
|
|
|
|
|
|
737
|
0
|
|
|
|
|
0
|
my ($sth, $res) = $self->_execute($dbh, $sql); |
|
738
|
0
|
|
|
|
|
0
|
print $wh $json->encode({result => $res}), "\n"; |
|
739
|
|
|
|
|
|
|
|
|
740
|
0
|
0
|
|
|
|
0
|
eval { |
|
741
|
0
|
0
|
|
|
|
0
|
if (my $on_ready = $params{on_ready}) { |
|
742
|
0
|
0
|
|
|
|
0
|
if (my $fetch = $on_ready->($dbh, $sth, $res, $sql)) { |
|
743
|
0
|
|
|
|
|
0
|
while (my $row = $fetch->()) { |
|
744
|
0
|
|
|
|
|
0
|
print $wh $json->encode($row), "\n"; |
|
745
|
|
|
|
|
|
|
} |
|
746
|
|
|
|
|
|
|
} |
|
747
|
|
|
|
|
|
|
} |
|
748
|
|
|
|
|
|
|
|
|
749
|
0
|
|
|
|
|
0
|
close($wh); |
|
750
|
0
|
|
|
|
|
0
|
1; |
|
751
|
|
|
|
|
|
|
} or warn $@; |
|
752
|
0
|
|
|
|
|
0
|
$guard->dismiss(); |
|
753
|
0
|
|
|
|
|
0
|
POSIX::_exit(0); |
|
754
|
|
|
|
|
|
|
} |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
#################### |
|
757
|
|
|
|
|
|
|
# }}} STH BUILDERS # |
|
758
|
|
|
|
|
|
|
#################### |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
########################### |
|
761
|
|
|
|
|
|
|
# {{{ Transaction Related # |
|
762
|
|
|
|
|
|
|
########################### |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
sub _start_internal_txn { |
|
765
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
766
|
0
|
|
|
|
|
0
|
my (%params) = @_; |
|
767
|
|
|
|
|
|
|
|
|
768
|
0
|
|
|
|
|
0
|
my $con = $self->{+CONNECTION}; |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# Already inside a txn |
|
771
|
0
|
0
|
|
|
|
0
|
return undef if $con->in_txn; |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# Internal TXNs are allowed, use one |
|
774
|
0
|
0
|
|
|
|
0
|
return $con->txn if $self->{+INTERNAL_TRANSACTIONS}; |
|
775
|
|
|
|
|
|
|
|
|
776
|
0
|
0
|
|
|
|
0
|
carp "Internal transactions are disabled: $params{warn}" if $params{warn}; |
|
777
|
0
|
0
|
|
|
|
0
|
croak "Internal transactions are disabled: $params{die}" if $params{die}; |
|
778
|
|
|
|
|
|
|
|
|
779
|
0
|
|
|
|
|
0
|
return undef; |
|
780
|
|
|
|
|
|
|
} |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
sub _internal_txn { |
|
783
|
2
|
|
|
2
|
|
5
|
my $self = shift; |
|
784
|
2
|
|
|
|
|
12
|
my ($cb, %params) = @_; |
|
785
|
|
|
|
|
|
|
|
|
786
|
2
|
|
|
|
|
6
|
my $con = $self->{+CONNECTION}; |
|
787
|
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
# Already inside a txn |
|
789
|
2
|
50
|
|
|
|
13
|
return $cb->() if $con->in_txn; |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
# Internal TXNs are allowed, use one |
|
792
|
2
|
50
|
|
|
|
25
|
return $con->txn($cb) if $self->{+INTERNAL_TRANSACTIONS}; |
|
793
|
|
|
|
|
|
|
|
|
794
|
0
|
0
|
|
|
|
0
|
carp "Internal transactions are disabled: $params{warn}" if $params{warn}; |
|
795
|
0
|
0
|
|
|
|
0
|
croak "Internal transactions are disabled: $params{die}" if $params{die}; |
|
796
|
|
|
|
|
|
|
|
|
797
|
0
|
0
|
|
|
|
0
|
return undef if $params{noop}; |
|
798
|
|
|
|
|
|
|
|
|
799
|
0
|
|
|
|
|
0
|
return $cb->(); |
|
800
|
|
|
|
|
|
|
} |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
########################### |
|
803
|
|
|
|
|
|
|
# }}} Transaction Related # |
|
804
|
|
|
|
|
|
|
########################### |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
######################## |
|
807
|
|
|
|
|
|
|
# {{{ Results Fetchers # |
|
808
|
|
|
|
|
|
|
######################## |
|
809
|
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
sub _fixture_arg { |
|
811
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
812
|
0
|
|
|
|
|
0
|
my ($arg) = @_; |
|
813
|
0
|
|
|
|
|
0
|
$self->{+TARGET} = $arg; |
|
814
|
|
|
|
|
|
|
} |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
sub by_id { |
|
817
|
6
|
|
|
6
|
1
|
4967
|
my $id = pop; |
|
818
|
6
|
|
|
|
|
27
|
my $self = shift->handle(@_); |
|
819
|
|
|
|
|
|
|
|
|
820
|
6
|
50
|
|
|
|
23
|
croak "Cannot call by_ids() on a handle with a where clause" if $self->{+WHERE}; |
|
821
|
6
|
50
|
|
|
|
18
|
croak "Cannot call by_ids() on a handle with an associated row" if $self->{+ROW}; |
|
822
|
|
|
|
|
|
|
|
|
823
|
6
|
|
|
|
|
14
|
my $source = $self->{+SOURCE}; |
|
824
|
|
|
|
|
|
|
|
|
825
|
6
|
|
|
|
|
10
|
my $where; |
|
826
|
6
|
|
|
|
|
15
|
my $ref = ref($id); |
|
827
|
|
|
|
|
|
|
#<<< |
|
828
|
6
|
100
|
|
|
|
23
|
if ($ref eq 'HASH') { $where = $id; $id = [ map { $where->{$_} } @{$source->primary_key} ] } |
|
|
2
|
100
|
|
|
|
6
|
|
|
|
2
|
50
|
|
|
|
6
|
|
|
|
2
|
|
|
|
|
10
|
|
|
|
2
|
|
|
|
|
27
|
|
|
829
|
2
|
|
|
|
|
19
|
elsif ($ref eq 'ARRAY') { $where = +{ mesh($source->primary_key, $id) } } |
|
830
|
2
|
|
|
|
|
4
|
elsif (!$ref) { $id = [ $id ]; $where = +{ mesh($source->primary_key, $id) } } |
|
|
2
|
|
|
|
|
18
|
|
|
831
|
|
|
|
|
|
|
#>>> |
|
832
|
|
|
|
|
|
|
|
|
833
|
6
|
50
|
|
|
|
27
|
croak "Unrecognized primary key format: $id" unless ref($id) eq 'ARRAY'; |
|
834
|
|
|
|
|
|
|
|
|
835
|
6
|
|
|
|
|
31
|
my $row = $self->{+CONNECTION}->state_cache_lookup($source, $id); |
|
836
|
6
|
|
66
|
|
|
43
|
return $row //= $self->where($where)->one(); |
|
837
|
|
|
|
|
|
|
} |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
sub by_ids { |
|
840
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
841
|
0
|
0
|
|
|
|
0
|
croak "Cannot call by_ids() on a handle with a where clause" if $self->{+WHERE}; |
|
842
|
0
|
0
|
|
|
|
0
|
croak "Cannot call by_ids() on a handle with an associated row" if $self->{+ROW}; |
|
843
|
0
|
|
|
|
|
0
|
return [map { $self->by_id($_) } @_]; |
|
|
0
|
|
|
|
|
0
|
|
|
844
|
|
|
|
|
|
|
} |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
sub vivify { |
|
847
|
2
|
50
|
|
2
|
1
|
11
|
croak "Not enough arguments to vivify()" if @_ < 2; |
|
848
|
2
|
50
|
|
|
|
9
|
my $data = pop or croak "You must provide a data hashref as the final argument to vivify()"; |
|
849
|
2
|
50
|
|
|
|
10
|
croak "last argument to vivify() must be a hashref, got '$data'" unless ref($data) eq 'HASH'; |
|
850
|
|
|
|
|
|
|
|
|
851
|
2
|
|
|
|
|
9
|
my $self = shift->handle(@_); |
|
852
|
|
|
|
|
|
|
|
|
853
|
2
|
|
|
|
|
16
|
$self->{+CONNECTION}->pid_check; |
|
854
|
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
return $self->{+CONNECTION}->state_vivify_row( |
|
856
|
2
|
|
|
|
|
14
|
source => $self->{+SOURCE}, |
|
857
|
|
|
|
|
|
|
fetched => $data, |
|
858
|
|
|
|
|
|
|
); |
|
859
|
|
|
|
|
|
|
} |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
sub _builder_args { |
|
862
|
160
|
|
|
160
|
|
487
|
my $self = shift; |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
return { |
|
865
|
|
|
|
|
|
|
source => $self->{+SOURCE}, |
|
866
|
|
|
|
|
|
|
where => $self->{+WHERE}, |
|
867
|
|
|
|
|
|
|
limit => $self->{+LIMIT}, |
|
868
|
160
|
|
|
|
|
1050
|
order_by => $self->{+ORDER_BY}, |
|
869
|
|
|
|
|
|
|
fields => $self->fields, |
|
870
|
|
|
|
|
|
|
dialect => $self->dialect, |
|
871
|
|
|
|
|
|
|
}; |
|
872
|
|
|
|
|
|
|
} |
|
873
|
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
sub _row_or_hashref { |
|
875
|
160
|
|
|
160
|
|
411
|
my $self = shift; |
|
876
|
160
|
|
|
|
|
419
|
my $meth = shift; |
|
877
|
|
|
|
|
|
|
|
|
878
|
160
|
100
|
|
|
|
16743
|
return $self unless @_; |
|
879
|
|
|
|
|
|
|
|
|
880
|
128
|
100
|
|
|
|
586
|
if (@_ == 1) { |
|
881
|
118
|
|
|
|
|
290
|
my $item = shift @_; |
|
882
|
|
|
|
|
|
|
|
|
883
|
118
|
50
|
|
|
|
537
|
if (my $r = ref($item)) { |
|
884
|
118
|
100
|
66
|
|
|
947
|
return $self->row($item) if blessed($item) && $item->DOES('DBIx::QuickORM::Role::Row'); |
|
885
|
106
|
50
|
|
|
|
947
|
return $self->$meth($item) if $r eq 'HASH'; |
|
886
|
|
|
|
|
|
|
} |
|
887
|
|
|
|
|
|
|
|
|
888
|
0
|
|
|
|
|
0
|
croak "'$item' is not a row or hashref"; |
|
889
|
|
|
|
|
|
|
} |
|
890
|
|
|
|
|
|
|
|
|
891
|
10
|
|
|
|
|
109
|
return $self->$meth({ @_ }); |
|
892
|
|
|
|
|
|
|
} |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
sub upsert { |
|
895
|
2
|
|
|
2
|
1
|
27
|
my $self = shift->_row_or_hashref(TARGET() => @_); |
|
896
|
2
|
50
|
|
|
|
10
|
return $self->_insert_and_refresh(upsert => 1) if $self->{+AUTO_REFRESH}; |
|
897
|
2
|
|
|
|
|
9
|
return $self->_insert(upsert => 1); |
|
898
|
|
|
|
|
|
|
} |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
sub upsert_and_refresh { |
|
901
|
0
|
|
|
0
|
1
|
0
|
my $self = shift->_row_or_hashref(TARGET() => @_); |
|
902
|
0
|
|
|
|
|
0
|
return $self->_insert_and_refresh(upsert => 1); |
|
903
|
|
|
|
|
|
|
} |
|
904
|
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sub insert { |
|
906
|
78
|
|
|
78
|
1
|
9165
|
my $self = shift->_row_or_hashref(TARGET() => @_); |
|
907
|
78
|
100
|
|
|
|
377
|
return $self->_insert_and_refresh() if $self->{+AUTO_REFRESH}; |
|
908
|
77
|
|
|
|
|
427
|
return $self->_insert(); |
|
909
|
|
|
|
|
|
|
} |
|
910
|
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
sub insert_and_refresh { |
|
912
|
0
|
|
|
0
|
1
|
0
|
my $self = shift->_row_or_hashref(TARGET() => @_); |
|
913
|
0
|
|
|
|
|
0
|
return $self->_insert_and_refresh(); |
|
914
|
|
|
|
|
|
|
} |
|
915
|
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
sub _insert_and_refresh { |
|
917
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
|
918
|
1
|
|
|
|
|
4
|
my %params = @_; |
|
919
|
|
|
|
|
|
|
|
|
920
|
1
|
50
|
|
|
|
22
|
croak "Cannot refresh a row without a primary key" unless $self->_has_pk; |
|
921
|
|
|
|
|
|
|
|
|
922
|
1
|
50
|
|
|
|
7
|
return $self->handle(AUTO_REFRESH() => 1)->_insert(%params) if $self->dialect->supports_returning_insert; |
|
923
|
|
|
|
|
|
|
|
|
924
|
0
|
|
|
|
|
0
|
my $row = $self->_insert(%params); |
|
925
|
|
|
|
|
|
|
|
|
926
|
0
|
0
|
|
|
|
0
|
if ($self->is_sync) { |
|
927
|
0
|
|
|
|
|
0
|
$row->refresh(); |
|
928
|
|
|
|
|
|
|
} |
|
929
|
|
|
|
|
|
|
else { |
|
930
|
0
|
|
|
|
|
0
|
$row->{auto_refresh} = 1; |
|
931
|
|
|
|
|
|
|
} |
|
932
|
|
|
|
|
|
|
|
|
933
|
0
|
|
|
|
|
0
|
return $row; |
|
934
|
|
|
|
|
|
|
} |
|
935
|
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
sub _insert { |
|
937
|
80
|
|
|
80
|
|
187
|
my $self = shift; |
|
938
|
80
|
|
|
|
|
246
|
my %params = @_; |
|
939
|
|
|
|
|
|
|
|
|
940
|
80
|
|
|
|
|
293
|
my $upsert = $params{upsert}; |
|
941
|
|
|
|
|
|
|
|
|
942
|
80
|
50
|
|
|
|
323
|
croak "Cannot insert rows using a handle with data_only set" if $self->{+DATA_ONLY}; |
|
943
|
80
|
50
|
|
|
|
316
|
croak "Cannot insert rows using a handle with a limit set" if defined $self->{+LIMIT}; |
|
944
|
80
|
50
|
|
|
|
338
|
croak "Cannot insert rows using a handle with an order_by set" if defined $self->{+ORDER_BY}; |
|
945
|
|
|
|
|
|
|
|
|
946
|
80
|
|
|
|
|
161
|
my $data; |
|
947
|
80
|
100
|
|
|
|
367
|
if (my $in = $self->{+TARGET}) { |
|
948
|
78
|
50
|
|
|
|
374
|
$data = $in if ref($in) eq 'HASH'; |
|
949
|
78
|
50
|
|
|
|
342
|
croak "Not sure how to insert '$in'" unless $data; |
|
950
|
|
|
|
|
|
|
} |
|
951
|
|
|
|
|
|
|
|
|
952
|
80
|
100
|
|
|
|
499
|
if (my $row = $self->{+ROW}) { |
|
953
|
2
|
50
|
|
|
|
11
|
croak "Cannot provide both a row and data to insert()" if $data; |
|
954
|
2
|
50
|
|
|
|
10
|
croak "Cannot insert a row that is already stored" if $row->in_storage; |
|
955
|
2
|
50
|
|
|
|
66
|
$data = $row->row_data_obj->pending_data or croak "Row has no pending data to insert"; |
|
956
|
|
|
|
|
|
|
} |
|
957
|
|
|
|
|
|
|
|
|
958
|
80
|
50
|
|
|
|
273
|
croak "No data provided to insert" unless $data; |
|
959
|
80
|
50
|
|
|
|
351
|
croak "Refusing to insert an empty row" unless keys %$data; |
|
960
|
|
|
|
|
|
|
|
|
961
|
80
|
|
|
|
|
233
|
my $source = $self->{+SOURCE}; |
|
962
|
80
|
|
|
|
|
404
|
my $dialect = $self->dialect; |
|
963
|
|
|
|
|
|
|
|
|
964
|
80
|
|
|
|
|
382
|
my $builder_args = $self->_builder_args; |
|
965
|
80
|
|
|
|
|
216
|
my $fields = $builder_args->{fields}; |
|
966
|
|
|
|
|
|
|
|
|
967
|
80
|
|
|
|
|
471
|
for my $col ($source->columns) { |
|
968
|
217
|
100
|
|
|
|
1046
|
my $def = $col->perl_default or next; |
|
969
|
2
|
|
|
|
|
10
|
my $name = $col->name; |
|
970
|
|
|
|
|
|
|
|
|
971
|
2
|
100
|
|
|
|
12
|
$data->{$name} = $def->() unless exists $data->{$name}; |
|
972
|
|
|
|
|
|
|
} |
|
973
|
|
|
|
|
|
|
|
|
974
|
80
|
|
|
|
|
300
|
my $has_pk = $self->_has_pk; |
|
975
|
80
|
|
|
|
|
555
|
my $has_ret = $dialect->supports_returning_insert; |
|
976
|
|
|
|
|
|
|
|
|
977
|
80
|
50
|
66
|
|
|
661
|
if ($has_pk && @$has_pk > 1 && !$has_ret) { |
|
|
|
|
33
|
|
|
|
|
|
978
|
|
|
|
|
|
|
croak "Database-Auto-Generated compound primary keys are not supported for databases that do not support 'returning on insert' functionality" |
|
979
|
0
|
0
|
|
|
|
0
|
if grep { !$data->{$_} } @$has_pk; |
|
|
0
|
|
|
|
|
0
|
|
|
980
|
|
|
|
|
|
|
} |
|
981
|
|
|
|
|
|
|
|
|
982
|
80
|
|
|
|
|
271
|
$builder_args->{insert} = $data; |
|
983
|
|
|
|
|
|
|
|
|
984
|
80
|
100
|
66
|
|
|
443
|
if ($has_ret && $has_pk) { |
|
985
|
77
|
|
|
|
|
179
|
my %seen; |
|
986
|
|
|
|
|
|
|
# @fields might omit some fields specified in $data, so we want to include any that were in data |
|
987
|
77
|
100
|
|
|
|
386
|
$builder_args->{returning} = $self->{+AUTO_REFRESH} ? [ grep { !$seen{$_}++ } @$has_pk, @$fields, keys %$data ] : $has_pk; |
|
|
5
|
|
|
|
|
18
|
|
|
988
|
|
|
|
|
|
|
} |
|
989
|
|
|
|
|
|
|
|
|
990
|
80
|
100
|
|
|
|
289
|
my $meth = $upsert ? 'qorm_upsert' : 'qorm_insert'; |
|
991
|
80
|
|
|
|
|
406
|
my $sql = $self->sql_builder->$meth(%$builder_args); |
|
992
|
|
|
|
|
|
|
my $sth = $self->_make_sth( |
|
993
|
|
|
|
|
|
|
$sql, |
|
994
|
|
|
|
|
|
|
only_one => 1, |
|
995
|
|
|
|
|
|
|
on_ready => sub { |
|
996
|
79
|
|
|
79
|
|
404
|
my ($dbh, $sth, $res, $sql) = @_; |
|
997
|
|
|
|
|
|
|
|
|
998
|
79
|
|
|
|
|
205
|
my $row_data; |
|
999
|
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
# Add generated PKs, mixed with insert values |
|
1001
|
79
|
100
|
|
|
|
4377
|
if ($builder_args->{returning}) { |
|
|
|
50
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
$row_data = { |
|
1003
|
|
|
|
|
|
|
%$data, |
|
1004
|
76
|
|
|
|
|
580
|
%{$sth->fetchrow_hashref}, |
|
|
76
|
|
|
|
|
1786091
|
|
|
1005
|
|
|
|
|
|
|
}; |
|
1006
|
|
|
|
|
|
|
} |
|
1007
|
|
|
|
|
|
|
elsif($has_pk) { |
|
1008
|
0
|
|
|
|
|
0
|
my $kv = $dbh->last_insert_id(undef, undef, $self->{+SOURCE}->source_db_moniker); |
|
1009
|
0
|
|
|
|
|
0
|
$row_data = { |
|
1010
|
|
|
|
|
|
|
%$data, |
|
1011
|
|
|
|
|
|
|
$has_pk->[0] => $kv, |
|
1012
|
|
|
|
|
|
|
}; |
|
1013
|
|
|
|
|
|
|
} |
|
1014
|
|
|
|
|
|
|
else { |
|
1015
|
3
|
|
|
|
|
26
|
$row_data = { %$data }; |
|
1016
|
|
|
|
|
|
|
} |
|
1017
|
|
|
|
|
|
|
|
|
1018
|
79
|
|
|
|
|
788
|
my $sent = 0; |
|
1019
|
79
|
100
|
|
|
|
1709
|
return sub { $sent++ ? () : $row_data }; |
|
|
158
|
|
|
|
|
670
|
|
|
1020
|
|
|
|
|
|
|
}, |
|
1021
|
80
|
|
|
|
|
1136
|
); |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
79
|
50
|
|
|
|
598
|
if ($sth->DOES('DBIx::QuickORM::Role::Async')) { |
|
1024
|
|
|
|
|
|
|
return DBIx::QuickORM::Row::Async->new( |
|
1025
|
|
|
|
|
|
|
async => $sth, |
|
1026
|
|
|
|
|
|
|
state_method => 'state_insert_row', |
|
1027
|
0
|
|
|
|
|
0
|
state_args => [row => $self->{+ROW}], |
|
1028
|
|
|
|
|
|
|
); |
|
1029
|
|
|
|
|
|
|
} |
|
1030
|
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
return $self->{+CONNECTION}->state_insert_row( |
|
1032
|
|
|
|
|
|
|
source => $source, |
|
1033
|
|
|
|
|
|
|
fetched => $sth->next, |
|
1034
|
79
|
|
|
|
|
3590
|
row => $self->{+ROW}, |
|
1035
|
|
|
|
|
|
|
); |
|
1036
|
|
|
|
|
|
|
} |
|
1037
|
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
sub delete { |
|
1039
|
4
|
|
|
4
|
1
|
4875
|
my $self = shift->_row_or_hashref(WHERE() => @_); |
|
1040
|
|
|
|
|
|
|
|
|
1041
|
4
|
50
|
|
|
|
22
|
croak "Cannot delete rows using a handle with data_only set" if $self->{+DATA_ONLY}; |
|
1042
|
|
|
|
|
|
|
|
|
1043
|
4
|
|
|
|
|
14
|
my $con = $self->{+CONNECTION}; |
|
1044
|
4
|
|
|
|
|
32
|
$con->pid_and_async_check; |
|
1045
|
|
|
|
|
|
|
|
|
1046
|
4
|
|
|
|
|
158
|
my $sync = $self->is_sync; |
|
1047
|
4
|
|
|
|
|
18
|
my $source = $self->{+SOURCE}; |
|
1048
|
4
|
|
|
|
|
24
|
my $dialect = $self->dialect; |
|
1049
|
4
|
|
|
|
|
14
|
my $row = $self->{+ROW}; |
|
1050
|
4
|
|
|
|
|
47
|
my $has_pk = $self->_has_pk; |
|
1051
|
4
|
|
|
|
|
22
|
my $builder_args = $self->_builder_args; |
|
1052
|
4
|
|
|
|
|
27
|
my $do_cache = $con->state_does_cache; |
|
1053
|
4
|
|
|
|
|
31
|
my $has_ret = $dialect->supports_returning_delete; |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
4
|
50
|
33
|
|
|
58
|
$builder_args->{returning} = $has_pk if $do_cache && $has_ret && $has_pk; |
|
|
|
|
33
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
|
|
1057
|
4
|
|
|
|
|
22
|
my $sql = $self->sql_builder->qorm_delete(%$builder_args); |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
# No cache, just do the delete |
|
1060
|
4
|
50
|
|
|
|
54
|
unless ($do_cache) { |
|
1061
|
0
|
|
|
|
|
0
|
my $sth = $self->_make_sth($sql, no_rows => 1); |
|
1062
|
0
|
0
|
|
|
|
0
|
$con->state_delete_row(source => $source, row => $row) if $row; |
|
1063
|
0
|
0
|
|
|
|
0
|
return $sync ? () : $sth; |
|
1064
|
|
|
|
|
|
|
} |
|
1065
|
|
|
|
|
|
|
|
|
1066
|
4
|
|
|
|
|
91
|
my $done = 0; |
|
1067
|
4
|
|
|
|
|
12
|
my $rows; |
|
1068
|
|
|
|
|
|
|
my $finish = sub { |
|
1069
|
8
|
100
|
|
8
|
|
40
|
return if $done++; |
|
1070
|
|
|
|
|
|
|
|
|
1071
|
4
|
|
|
|
|
17
|
my ($dbh, $sth) = @_; |
|
1072
|
4
|
|
|
|
|
16
|
my $source = $self->{+SOURCE}; |
|
1073
|
|
|
|
|
|
|
|
|
1074
|
4
|
50
|
|
|
|
18
|
if ($rows) { |
|
1075
|
0
|
|
|
|
|
0
|
$con->state_delete_row(source => $source, fetched => $_) for @$rows; |
|
1076
|
0
|
|
|
|
|
0
|
return; |
|
1077
|
|
|
|
|
|
|
} |
|
1078
|
|
|
|
|
|
|
|
|
1079
|
4
|
100
|
|
|
|
35
|
if ($row) { |
|
1080
|
2
|
|
|
|
|
17
|
$con->state_delete_row(source => $source, row => $row); |
|
1081
|
2
|
|
|
|
|
8
|
return; |
|
1082
|
|
|
|
|
|
|
} |
|
1083
|
|
|
|
|
|
|
|
|
1084
|
2
|
50
|
|
|
|
12
|
if ($has_ret) { |
|
1085
|
2
|
|
|
|
|
122
|
while (my $r = $sth->fetchrow_hashref) { |
|
1086
|
6
|
|
|
|
|
58
|
$con->state_delete_row(source => $source, fetched => $r); |
|
1087
|
|
|
|
|
|
|
} |
|
1088
|
|
|
|
|
|
|
|
|
1089
|
2
|
|
|
|
|
13
|
return; |
|
1090
|
|
|
|
|
|
|
} |
|
1091
|
|
|
|
|
|
|
|
|
1092
|
0
|
|
|
|
|
0
|
confess "This error should be unreachable, please report it along with this dump:\n==== start ====\n" . debug($self) . "\n==== stop ====\n"; |
|
1093
|
4
|
|
|
|
|
44
|
}; |
|
1094
|
|
|
|
|
|
|
|
|
1095
|
4
|
|
|
|
|
10
|
my $sth; |
|
1096
|
4
|
50
|
33
|
|
|
25
|
if ($has_ret || $row) { |
|
1097
|
4
|
|
|
|
|
27
|
$sth = $self->_make_sth($sql, on_ready => $finish, no_rows => 1); |
|
1098
|
|
|
|
|
|
|
} |
|
1099
|
|
|
|
|
|
|
else { |
|
1100
|
0
|
0
|
|
|
|
0
|
croak "Cannot do an async delete without a specific row to delete on a database that does not support 'returning on delete'" unless $sync; |
|
1101
|
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
$self->_internal_txn( |
|
1103
|
|
|
|
|
|
|
sub { |
|
1104
|
0
|
|
|
0
|
|
0
|
my $row_sql = $self->sql_builder->qorm_select(%$builder_args, fields => $has_pk); |
|
1105
|
0
|
|
|
|
|
0
|
my ($row_sth, $row_res) = $self->_execute($self->{+CONNECTION}->dbh, $row_sql); |
|
1106
|
0
|
|
|
|
|
0
|
$rows = $row_sth->fetchall_arrayref({}); |
|
1107
|
0
|
|
|
|
|
0
|
$sth = $self->_make_sth($sql, on_ready => $finish, no_rows => 1); |
|
1108
|
|
|
|
|
|
|
}, |
|
1109
|
0
|
|
|
|
|
0
|
die => "Cannot delete without a specific row on a database that does not support 'returning on delete' when internal transactions are disabled", |
|
1110
|
|
|
|
|
|
|
); |
|
1111
|
|
|
|
|
|
|
} |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
4
|
50
|
|
|
|
30
|
return $sth unless $sync; |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
4
|
|
|
|
|
70
|
$finish->($sth->dbh, $sth->sth); |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
4
|
|
|
|
|
29
|
return undef; |
|
1118
|
|
|
|
|
|
|
} |
|
1119
|
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
sub update { |
|
1121
|
12
|
|
|
12
|
1
|
33
|
my $changes; |
|
1122
|
12
|
|
|
2
|
|
88
|
my $self = shift->_row_or_hashref(sub {$changes = pop; $_[0]}, @_); |
|
|
2
|
|
|
|
|
6
|
|
|
|
2
|
|
|
|
|
7
|
|
|
1123
|
|
|
|
|
|
|
|
|
1124
|
12
|
|
|
|
|
62
|
my $con = $self->{+CONNECTION}; |
|
1125
|
12
|
|
|
|
|
67
|
$con->pid_and_async_check; |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
12
|
50
|
|
|
|
48
|
croak "update() with data_only set is not currently supported" if $self->{+DATA_ONLY}; |
|
1128
|
12
|
50
|
|
|
|
45
|
croak "update() with a 'limit' clause is not currently supported" if $self->{+LIMIT}; |
|
1129
|
12
|
50
|
|
|
|
48
|
croak "update() with an 'order_by' clause is not currently supported" if $self->{+ORDER_BY}; |
|
1130
|
|
|
|
|
|
|
|
|
1131
|
12
|
|
|
|
|
50
|
my $row = $self->{+ROW}; |
|
1132
|
12
|
100
|
|
|
|
65
|
if ($changes) { |
|
|
|
50
|
|
|
|
|
|
|
1133
|
2
|
50
|
|
|
|
27
|
if ($row) { |
|
1134
|
0
|
0
|
|
|
|
0
|
if (my $pending = $row->pending_data) { |
|
1135
|
0
|
0
|
0
|
|
|
0
|
croak "Attempt to update row with pending changes and additional changes" |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
if $changes && $pending && keys(%$changes) && keys(%$pending); |
|
1137
|
|
|
|
|
|
|
} |
|
1138
|
|
|
|
|
|
|
} |
|
1139
|
|
|
|
|
|
|
} |
|
1140
|
|
|
|
|
|
|
elsif ($row) { |
|
1141
|
10
|
|
|
|
|
42
|
$changes = $row->pending_data; |
|
1142
|
|
|
|
|
|
|
} |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
12
|
50
|
|
|
|
43
|
croak "No changes for update" unless $changes; |
|
1145
|
12
|
50
|
|
|
|
77
|
croak "Changes must be a hashref (got $changes)" unless ref($changes) eq 'HASH'; |
|
1146
|
12
|
50
|
|
|
|
41
|
croak "Changes may not be empty" unless keys %$changes; |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
12
|
|
|
|
|
67
|
my $sync = $self->is_sync; |
|
1149
|
12
|
|
|
|
|
74
|
my $dialect = $self->dialect; |
|
1150
|
12
|
|
|
|
|
61
|
my $pk_fields = $self->_has_pk; |
|
1151
|
12
|
|
|
|
|
48
|
my $builder_args = $self->_builder_args; |
|
1152
|
12
|
|
|
|
|
35
|
my $source = $self->{+SOURCE}; |
|
1153
|
12
|
|
33
|
|
|
119
|
my $do_cache = $pk_fields && @$pk_fields && $con->state_does_cache; |
|
1154
|
12
|
50
|
|
|
|
50
|
my $changes_pk_fields = $pk_fields ? (grep { $changes->{$_} } @$pk_fields) : (); |
|
|
12
|
|
|
|
|
41
|
|
|
1155
|
|
|
|
|
|
|
|
|
1156
|
12
|
|
|
|
|
56
|
my $sql = $self->sql_builder->qorm_update(%$builder_args, update => $changes); |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
# No cache, or not cachable, just do the update |
|
1159
|
12
|
50
|
|
|
|
58
|
unless ($do_cache) { |
|
1160
|
0
|
|
|
|
|
0
|
my $sth = $self->_make_sth($sql, no_rows => 1); |
|
1161
|
0
|
0
|
|
|
|
0
|
return $sth unless $sync; |
|
1162
|
0
|
|
|
|
|
0
|
return; |
|
1163
|
|
|
|
|
|
|
} |
|
1164
|
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
my $handle_row = sub { |
|
1166
|
12
|
|
|
12
|
|
38
|
my ($row) = @_; |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
12
|
|
|
|
|
30
|
my ($old_pk, $new_pk, $fetched); |
|
1169
|
12
|
100
|
|
|
|
45
|
if (blessed($row)) { |
|
1170
|
10
|
50
|
|
|
|
35
|
$old_pk = $changes_pk_fields ? [ $row->primary_key_value_list ] : undef; |
|
1171
|
10
|
|
|
|
|
24
|
$fetched = { %{$row->stored_data}, %$changes}; |
|
|
10
|
|
|
|
|
101
|
|
|
1172
|
|
|
|
|
|
|
} |
|
1173
|
|
|
|
|
|
|
else { |
|
1174
|
2
|
100
|
|
|
|
12
|
$old_pk = $changes_pk_fields ? [ map { $row->{$_} } @$pk_fields ] : undef; |
|
|
1
|
|
|
|
|
8
|
|
|
1175
|
2
|
|
|
|
|
16
|
$fetched = { %$row, %$changes }; |
|
1176
|
|
|
|
|
|
|
} |
|
1177
|
|
|
|
|
|
|
|
|
1178
|
12
|
100
|
|
|
|
73
|
$new_pk = $changes_pk_fields ? [ map { $fetched->{$_} } @$pk_fields ] : undef; |
|
|
1
|
|
|
|
|
4
|
|
|
1179
|
|
|
|
|
|
|
|
|
1180
|
12
|
|
|
|
|
115
|
$con->state_update_row(old_primary_key => $old_pk, new_primary_key => $new_pk, fetched => $fetched, source => $source); |
|
1181
|
12
|
|
|
|
|
88
|
}; |
|
1182
|
|
|
|
|
|
|
|
|
1183
|
12
|
|
|
|
|
29
|
my $done = 0; |
|
1184
|
12
|
|
|
|
|
38
|
my $rows; |
|
1185
|
|
|
|
|
|
|
my $finish = sub { |
|
1186
|
24
|
100
|
|
24
|
|
100
|
return if $done++; |
|
1187
|
|
|
|
|
|
|
|
|
1188
|
12
|
|
|
|
|
45
|
my ($dbh, $sth) = @_; |
|
1189
|
12
|
|
|
|
|
42
|
my $source = $self->{+SOURCE}; |
|
1190
|
|
|
|
|
|
|
|
|
1191
|
12
|
100
|
|
|
|
51
|
if ($rows) { |
|
1192
|
2
|
|
|
|
|
12
|
$handle_row->($_) for @$rows; |
|
1193
|
2
|
|
|
|
|
6
|
return; |
|
1194
|
|
|
|
|
|
|
} |
|
1195
|
|
|
|
|
|
|
|
|
1196
|
10
|
50
|
|
|
|
48
|
if ($row) { |
|
1197
|
10
|
|
|
|
|
47
|
$handle_row->($row); |
|
1198
|
10
|
|
|
|
|
29
|
return; |
|
1199
|
|
|
|
|
|
|
} |
|
1200
|
|
|
|
|
|
|
|
|
1201
|
0
|
|
|
|
|
0
|
confess "This error should be unreachable, please report it along with this dump:\n==== start ====\n" . debug($self) . "\n==== stop ====\n"; |
|
1202
|
12
|
|
|
|
|
52
|
}; |
|
1203
|
|
|
|
|
|
|
|
|
1204
|
12
|
|
|
|
|
29
|
my $sth; |
|
1205
|
12
|
100
|
|
|
|
58
|
if ($row) { |
|
1206
|
10
|
|
|
|
|
106
|
$sth = $self->_make_sth($sql, on_ready => $finish, no_rows => 1); |
|
1207
|
|
|
|
|
|
|
} |
|
1208
|
|
|
|
|
|
|
else { |
|
1209
|
2
|
50
|
|
|
|
24
|
croak "Cannot do an async update without a specific row to update" unless $sync; |
|
1210
|
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
$self->_internal_txn( |
|
1212
|
|
|
|
|
|
|
sub { |
|
1213
|
2
|
|
|
2
|
|
9
|
my $row_sql = $self->sql_builder->qorm_select(%$builder_args, fields => $pk_fields); |
|
1214
|
2
|
|
|
|
|
17
|
my ($row_sth, $row_res) = $self->_execute($self->{+CONNECTION}->dbh, $row_sql); |
|
1215
|
2
|
|
|
|
|
38
|
$rows = $row_sth->fetchall_arrayref({}); |
|
1216
|
2
|
|
|
|
|
223
|
$sth = $self->_make_sth($sql, on_ready => $finish, no_rows => 1); |
|
1217
|
|
|
|
|
|
|
}, |
|
1218
|
2
|
|
|
|
|
17
|
die => "Cannot update without a specific row on a when internal transactions are disabled", |
|
1219
|
|
|
|
|
|
|
); |
|
1220
|
|
|
|
|
|
|
} |
|
1221
|
|
|
|
|
|
|
|
|
1222
|
12
|
50
|
|
|
|
94
|
return $sth unless $sync; |
|
1223
|
|
|
|
|
|
|
|
|
1224
|
12
|
|
|
|
|
129
|
$finish->($sth->dbh, $sth->sth); |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
12
|
|
|
|
|
82
|
return undef; |
|
1227
|
|
|
|
|
|
|
} |
|
1228
|
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
sub _do_select { |
|
1230
|
64
|
|
|
64
|
|
156
|
my $self = shift; |
|
1231
|
|
|
|
|
|
|
|
|
1232
|
64
|
|
|
|
|
174
|
my $con = $self->{+CONNECTION}; |
|
1233
|
64
|
|
|
|
|
485
|
$con->pid_and_async_check; |
|
1234
|
|
|
|
|
|
|
|
|
1235
|
64
|
|
|
|
|
304
|
my $sync = $self->is_sync; |
|
1236
|
64
|
|
|
|
|
196
|
my $source = $self->{+SOURCE}; |
|
1237
|
64
|
|
|
|
|
251
|
my $dialect = $self->dialect; |
|
1238
|
64
|
|
|
|
|
203
|
my $row = $self->{+ROW}; |
|
1239
|
64
|
|
|
|
|
273
|
my $builder_args = $self->_builder_args; |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
64
|
|
|
|
|
287
|
my $sql = $self->sql_builder->qorm_select(%$builder_args); |
|
1242
|
|
|
|
|
|
|
return $self->_make_sth( |
|
1243
|
|
|
|
|
|
|
$sql, |
|
1244
|
|
|
|
|
|
|
on_ready => sub { |
|
1245
|
58
|
|
|
58
|
|
193
|
my ($dbh, $sth) = @_; |
|
1246
|
58
|
|
|
|
|
560
|
return sub { $sth->fetchrow_hashref }; |
|
|
115
|
|
|
|
|
7948
|
|
|
1247
|
|
|
|
|
|
|
}, |
|
1248
|
64
|
|
|
|
|
854
|
@_, |
|
1249
|
|
|
|
|
|
|
); |
|
1250
|
|
|
|
|
|
|
} |
|
1251
|
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
sub one { |
|
1253
|
40
|
|
|
40
|
1
|
8166
|
my $self = shift->_row_or_hashref(WHERE() => @_); |
|
1254
|
|
|
|
|
|
|
|
|
1255
|
40
|
50
|
66
|
|
|
234
|
croak "Cannot return 'data_only' for one() with async/aside/forked" if $self->{+DATA_ONLY} && !$self->is_sync; |
|
1256
|
|
|
|
|
|
|
|
|
1257
|
40
|
|
|
|
|
201
|
my $sth = $self->_do_select(only_one => 1); |
|
1258
|
|
|
|
|
|
|
|
|
1259
|
39
|
100
|
|
|
|
409
|
if ($sth->DOES('DBIx::QuickORM::Role::Async')) { |
|
1260
|
|
|
|
|
|
|
return DBIx::QuickORM::Row::Async->new( |
|
1261
|
|
|
|
|
|
|
async => $sth, |
|
1262
|
|
|
|
|
|
|
state_method => 'state_select_row', |
|
1263
|
2
|
|
|
|
|
519
|
state_args => [row => $self->{+ROW}], |
|
1264
|
|
|
|
|
|
|
); |
|
1265
|
|
|
|
|
|
|
} |
|
1266
|
|
|
|
|
|
|
|
|
1267
|
37
|
100
|
|
|
|
16732
|
my $fetched = $sth->next or return undef; |
|
1268
|
|
|
|
|
|
|
|
|
1269
|
30
|
100
|
|
|
|
144
|
return $fetched if $self->{+DATA_ONLY}; |
|
1270
|
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
return $self->{+CONNECTION}->state_select_row( |
|
1272
|
|
|
|
|
|
|
source => $self->{+SOURCE}, |
|
1273
|
|
|
|
|
|
|
fetched => $fetched, |
|
1274
|
28
|
|
|
|
|
270
|
row => $self->{+ROW}, |
|
1275
|
|
|
|
|
|
|
); |
|
1276
|
|
|
|
|
|
|
} |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
sub first { |
|
1279
|
6
|
|
|
6
|
1
|
1530
|
my $self = shift->_row_or_hashref(WHERE() => @_); |
|
1280
|
|
|
|
|
|
|
|
|
1281
|
6
|
50
|
66
|
|
|
30
|
croak "Cannot return 'data_only' for first() with async/aside/forked" if $self->{+DATA_ONLY} && !$self->is_sync; |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
6
|
|
|
|
|
38
|
my $sth = $self->_do_select(); |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
6
|
100
|
|
|
|
143
|
if ($sth->DOES('DBIx::QuickORM::Role::Async')) { |
|
1286
|
|
|
|
|
|
|
return DBIx::QuickORM::Row::Async->new( |
|
1287
|
|
|
|
|
|
|
async => $sth, |
|
1288
|
|
|
|
|
|
|
state_method => 'state_select_row', |
|
1289
|
2
|
|
|
|
|
498
|
state_args => [row => $self->{+ROW}], |
|
1290
|
|
|
|
|
|
|
); |
|
1291
|
|
|
|
|
|
|
} |
|
1292
|
|
|
|
|
|
|
|
|
1293
|
4
|
50
|
|
|
|
137
|
my $fetched = $sth->next or return undef; |
|
1294
|
|
|
|
|
|
|
|
|
1295
|
4
|
100
|
|
|
|
18
|
return $fetched if $self->{+DATA_ONLY}; |
|
1296
|
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
return $self->{+CONNECTION}->state_select_row( |
|
1298
|
|
|
|
|
|
|
fetched => $fetched, |
|
1299
|
|
|
|
|
|
|
source => $self->{+SOURCE}, |
|
1300
|
3
|
|
|
|
|
21
|
row => $self->{+ROW}, |
|
1301
|
|
|
|
|
|
|
); |
|
1302
|
|
|
|
|
|
|
} |
|
1303
|
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
sub all { |
|
1305
|
7
|
|
|
7
|
1
|
85
|
my $self = shift->_row_or_hashref(WHERE() => @_); |
|
1306
|
|
|
|
|
|
|
|
|
1307
|
7
|
50
|
|
|
|
48
|
croak "all() cannot be used asynchronously, use iterate() to get an async iterator instead" |
|
1308
|
|
|
|
|
|
|
unless $self->is_sync; |
|
1309
|
|
|
|
|
|
|
|
|
1310
|
7
|
|
|
|
|
43
|
my $sth = $self->_do_select(); |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
7
|
100
|
|
|
|
43
|
return @{$sth->sth->fetchall_arrayref({})} if $self->{+DATA_ONLY}; |
|
|
2
|
|
|
|
|
52
|
|
|
1313
|
|
|
|
|
|
|
|
|
1314
|
5
|
|
|
|
|
13
|
my @out; |
|
1315
|
5
|
|
|
|
|
27
|
while (my $fetched = $sth->next) { |
|
1316
|
|
|
|
|
|
|
push @out => $self->{+CONNECTION}->state_select_row( |
|
1317
|
|
|
|
|
|
|
fetched => $fetched, |
|
1318
|
|
|
|
|
|
|
source => $self->{+SOURCE}, |
|
1319
|
14
|
|
|
|
|
98
|
row => $self->{+ROW}, |
|
1320
|
|
|
|
|
|
|
); |
|
1321
|
|
|
|
|
|
|
} |
|
1322
|
|
|
|
|
|
|
|
|
1323
|
5
|
|
|
|
|
52
|
return @out; |
|
1324
|
|
|
|
|
|
|
} |
|
1325
|
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
sub iterator { |
|
1327
|
4
|
|
|
4
|
1
|
922
|
my $self = shift->_row_or_hashref(WHERE() => @_); |
|
1328
|
|
|
|
|
|
|
|
|
1329
|
4
|
|
|
|
|
40
|
my $sth = $self->_do_select(); |
|
1330
|
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
return DBIx::QuickORM::Iterator->new( |
|
1332
|
6
|
|
|
6
|
|
12
|
sub { $sth->next }, |
|
1333
|
0
|
|
|
0
|
|
0
|
sub { $sth->ready }, |
|
1334
|
4
|
100
|
|
|
|
132
|
) if $self->{+DATA_ONLY}; |
|
1335
|
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
return DBIx::QuickORM::Iterator->new( |
|
1337
|
|
|
|
|
|
|
sub { |
|
1338
|
16
|
100
|
|
16
|
|
120
|
my $fetched = $sth->next or return; |
|
1339
|
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
return $self->{+CONNECTION}->state_select_row( |
|
1341
|
|
|
|
|
|
|
fetched => $fetched, |
|
1342
|
|
|
|
|
|
|
source => $self->{+SOURCE}, |
|
1343
|
13
|
|
|
|
|
131
|
row => $self->{+ROW}, |
|
1344
|
|
|
|
|
|
|
); |
|
1345
|
|
|
|
|
|
|
}, |
|
1346
|
0
|
|
|
0
|
|
0
|
sub { $sth->ready }, |
|
1347
|
3
|
|
|
|
|
282
|
); |
|
1348
|
|
|
|
|
|
|
} |
|
1349
|
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
sub count { |
|
1351
|
7
|
|
|
7
|
1
|
52
|
my $self = shift->_row_or_hashref(WHERE() => @_)->fields([\'COUNT(*) AS count']); |
|
1352
|
7
|
50
|
|
|
|
41
|
croak "count() cannot be used on an async handle" unless $self->is_sync; |
|
1353
|
7
|
|
|
|
|
37
|
my $sth = $self->_do_select(); |
|
1354
|
7
|
50
|
|
|
|
42
|
my $row = $sth->next or return undef; |
|
1355
|
7
|
|
|
|
|
66
|
return $row->{count}; |
|
1356
|
|
|
|
|
|
|
} |
|
1357
|
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
sub iterate { |
|
1359
|
0
|
|
|
0
|
1
|
|
my $cb = pop; |
|
1360
|
0
|
0
|
0
|
|
|
|
croak "The final argument to iterate must be a coderef, got '" . ($cb // '<UNDEF>') . "'" unless $cb && ref($cb) eq 'CODE'; |
|
|
|
|
0
|
|
|
|
|
|
1361
|
0
|
|
|
|
|
|
my $self = shift->_row_or_hashref(WHERE() => @_); |
|
1362
|
0
|
0
|
|
|
|
|
croak "iterate() cannot be used on an async handle" unless $self->is_sync; |
|
1363
|
|
|
|
|
|
|
|
|
1364
|
0
|
|
|
|
|
|
my $sth = $self->_do_select(); |
|
1365
|
0
|
|
|
|
|
|
while (my $fetched = $sth->next) { |
|
1366
|
0
|
0
|
|
|
|
|
if ($self->{+DATA_ONLY}) { |
|
1367
|
0
|
|
|
|
|
|
$cb->($fetched); |
|
1368
|
|
|
|
|
|
|
} |
|
1369
|
|
|
|
|
|
|
else { |
|
1370
|
|
|
|
|
|
|
my $row = $self->{+CONNECTION}->state_select_row( |
|
1371
|
|
|
|
|
|
|
fetched => $fetched, |
|
1372
|
|
|
|
|
|
|
source => $self->{+SOURCE}, |
|
1373
|
0
|
|
|
|
|
|
row => $self->{+ROW}, |
|
1374
|
|
|
|
|
|
|
); |
|
1375
|
0
|
|
|
|
|
|
$cb->($row); |
|
1376
|
|
|
|
|
|
|
} |
|
1377
|
|
|
|
|
|
|
} |
|
1378
|
|
|
|
|
|
|
|
|
1379
|
0
|
|
|
|
|
|
return; |
|
1380
|
|
|
|
|
|
|
} |
|
1381
|
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
######################## |
|
1383
|
|
|
|
|
|
|
# }}} Results Fetchers # |
|
1384
|
|
|
|
|
|
|
######################## |
|
1385
|
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
1; |
|
1387
|
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
__END__ |
|
1389
|
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
=head1 NAME |
|
1391
|
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
DBIx::QuickORM::Handle - A handle for building and executing queries. |
|
1393
|
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
1395
|
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
This object is the equivelent of the L<DBIx::Class::ResultSet> provided by |
|
1397
|
|
|
|
|
|
|
L<DBIx::Class>. It is not identical, and not intended to be a drop in |
|
1398
|
|
|
|
|
|
|
replacement. |
|
1399
|
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
A handle object allows you to compose queries, and execute them. |
|
1401
|
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
1403
|
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
use My::Orm qw/orm/; |
|
1405
|
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
# Get a connection to the orm |
|
1407
|
|
|
|
|
|
|
my $orm = orm('my_orm'); |
|
1408
|
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
# Get a handle on the 'people' table. This does NOT execute a query |
|
1410
|
|
|
|
|
|
|
my $people_handle = $orm->handle('people'); |
|
1411
|
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
# Do something for all rows in the people table. This DOES execute a query. |
|
1413
|
|
|
|
|
|
|
for my $person ($people_handle->all) { |
|
1414
|
|
|
|
|
|
|
... |
|
1415
|
|
|
|
|
|
|
} |
|
1416
|
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
# A handle for all people witht he 'smith' surname. |
|
1418
|
|
|
|
|
|
|
my $smith_handle = $people_handle->where({surname => 'smith'}); |
|
1419
|
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
# print the first names of all people with the 'smith' surname. |
|
1421
|
|
|
|
|
|
|
for my $person ($handle->all) { |
|
1422
|
|
|
|
|
|
|
print $person->field('first_name') . "\n" |
|
1423
|
|
|
|
|
|
|
} |
|
1424
|
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
=head1 METHODS |
|
1426
|
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
=head2 CONSTRUCTORS |
|
1428
|
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
=over 4 |
|
1430
|
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
=item $new_h = DBIx::QuickORM::Handle->new(@params) |
|
1432
|
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
=item $new_h = $h->clone(@params) |
|
1434
|
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
=item $new_h = $h->handle(@params) |
|
1436
|
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
C<new()>, C<handle()>, and C<clone()> are all aliases for the same |
|
1438
|
|
|
|
|
|
|
functionality. They can be used interchangably. |
|
1439
|
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
This can be used to duplicate an existing handle, or create a new one. So you |
|
1441
|
|
|
|
|
|
|
can call any of these on an existing instance, or on the handle class. |
|
1442
|
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
=back |
|
1444
|
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
=head3 CONSTRUCTOR ARGS |
|
1446
|
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
B<Note:> Some of these are mutually exclusive, an exception will be thrown if |
|
1448
|
|
|
|
|
|
|
you provide conflicting arguments. |
|
1449
|
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
B<Note:> Most of these are better documented in the L</"Immutators"> and |
|
1451
|
|
|
|
|
|
|
L</"Immucessors"> sections. |
|
1452
|
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
=over 4 |
|
1454
|
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=item Blessed Object that implements L<DBIx::QuickORM::Role::Source> |
|
1456
|
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
If a source object is in the args it is treated as the source. |
|
1458
|
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
=item Blessed Object that implements L<DBIx::QuickORM::Role::Row> |
|
1460
|
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
If a row object is in the args it will be set as the row the handle operates |
|
1462
|
|
|
|
|
|
|
on. This will also set the WHERE clause, and an exception will be thrown if you |
|
1463
|
|
|
|
|
|
|
attempt to set both. This will also set the SOURCE to be the rows source, an |
|
1464
|
|
|
|
|
|
|
exception will be thrown if you provide a source other than the one in the row. |
|
1465
|
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
=item Blessed Object that implements L<DBIx::QuickORM::Role::SQLBuilder> |
|
1467
|
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
Specify what L<DBIx::QuickORM::Role::SQLBuilder> implementation will be used. |
|
1469
|
|
|
|
|
|
|
The default is L<DBIx::QuickORM::SQLBuilder::SQLAbstract>. |
|
1470
|
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
=item Blessed Object that subclasses L<DBIx::QuickORM::Connection> |
|
1472
|
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
Sets the connection the handle should use. |
|
1474
|
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
=item \%hash - Where Clause |
|
1476
|
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
If a hashref is provided it will be used as the WHERE clause. |
|
1478
|
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
=item \@array - Order by |
|
1480
|
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
If an arrayref is provided it will be used as the ORDER_BY. |
|
1482
|
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
=item INTEGER - Limit |
|
1484
|
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
If a simple integer is provided it will be used as the query LIMIT. |
|
1486
|
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
=item $table_name - source |
|
1488
|
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
If a string is provided that does not match any other string, it will be |
|
1490
|
|
|
|
|
|
|
asusmed to be a table name and will be used as the source. |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
=item connection => $CONNECTION |
|
1493
|
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
You can specify the connection using the C<connection> key in a key/value pair. |
|
1495
|
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
=item source => $SOURCE |
|
1497
|
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
You can specify the source using the C<source> key in a key/value pair. |
|
1499
|
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
=item sql_builder => $SQL_BUILDER |
|
1501
|
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
You can specify the sql_builder using the C<sql_builder> key in a key/value pair. |
|
1503
|
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
=item row => $ROW |
|
1505
|
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
You can specify the row using the C<row> key in a key/value pair. |
|
1507
|
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
=item where => $WHERE |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
You can specify the where using the C<where> key in a key/value pair. |
|
1511
|
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
=item order_by => \@ORDER_BY |
|
1513
|
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
You can specify the order_by using the C<order_by> key in a key/value pair. |
|
1515
|
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
=item limit => $LIMIT |
|
1517
|
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
You can specify the limit using the C<limit> key in a key/value pair. |
|
1519
|
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
=item fields => \@FIELDS |
|
1521
|
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
You can specify the fields using the C<fields> key in a key/value pair. |
|
1523
|
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
=item omit => \@FIELDS |
|
1525
|
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
You can specify the omit using the C<omit> key in a key/value pair. |
|
1527
|
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
=item async => $BOOL |
|
1529
|
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
You can use the 'async' key and a boolean value to toggle async on/off. |
|
1531
|
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
=item aside => $BOOL |
|
1533
|
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
You can use the 'aside' key and a boolean value to toggle aside on/off. |
|
1535
|
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
=item forked => $BOOL |
|
1537
|
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
You can use the 'forked' key and a boolean value to toggle forked on/off. |
|
1539
|
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
=item auto_refresh => $BOOL |
|
1541
|
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
You can use the C<auto_refresh> key and a boolean to turn auto_refresh on and |
|
1543
|
|
|
|
|
|
|
off. |
|
1544
|
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
=item data_only => $BOOL |
|
1546
|
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
You can use the C<data_only> key and a boolean to turn data_only on and off. |
|
1548
|
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
=item internal_transactions => $BOOL |
|
1550
|
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
You can use the C<internal_transactions> key and a boolean to turn |
|
1552
|
|
|
|
|
|
|
internal_transactions on and off. |
|
1553
|
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
=item -FLAG => sub { ... } |
|
1555
|
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
This can be used to modify the behavior or error messages of the constructor. |
|
1557
|
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
=back |
|
1559
|
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
=head3 CONSTRUCTOR FLAGS |
|
1561
|
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
The following flags are all available to modify constructor behavior. |
|
1563
|
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
These are primarily useful for custom methods that modify or extend handle |
|
1565
|
|
|
|
|
|
|
behavior. |
|
1566
|
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
=over 4 |
|
1568
|
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
=item -allow_override => $BOOL |
|
1570
|
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
Defaults to true. |
|
1572
|
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
This allows overriding values from the original handle when cloning it: |
|
1574
|
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
my $h1 = DBIx::QuickORM::Handle->new(where => { id => 1 }); |
|
1576
|
|
|
|
|
|
|
my $h2 = $h1->handle({id => 2}); |
|
1577
|
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
The above is fine when allow_override is set to true. In most cases this is the |
|
1579
|
|
|
|
|
|
|
behavior you want. |
|
1580
|
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
The following will die and tell you that you tried to set the where clause when |
|
1582
|
|
|
|
|
|
|
the handle you are cloning already had one set: |
|
1583
|
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
my $h1 = DBIx::QuickORM::Handle->new(where => { id => 1 }); |
|
1585
|
|
|
|
|
|
|
my $h2 = $h1->handle(-allow_override => 0, {id => 2}); |
|
1586
|
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
=item -array => sub { my ($new_h, $arrayref) = @_; ...; return $bool } |
|
1588
|
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
You can use this flag to provide alternate behavior for when an arrayref is |
|
1590
|
|
|
|
|
|
|
provided as an argument. Normally it is treated as an ORDER_BY. You can provide |
|
1591
|
|
|
|
|
|
|
a callback that implements alternate behavior. Your callback will receive the |
|
1592
|
|
|
|
|
|
|
new handle and the arg as arguments. The sub should return true if the |
|
1593
|
|
|
|
|
|
|
alternate behavior handled the argument, it should return false to fallback to |
|
1594
|
|
|
|
|
|
|
the default behavior of treating it as an ORDER_BY. |
|
1595
|
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
-array => sub { |
|
1597
|
|
|
|
|
|
|
my ($new_h, $arrayref) = @_; |
|
1598
|
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
$did_alternate_behavior = ...; |
|
1600
|
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
return 1 if $did_alternate_behavior; |
|
1602
|
|
|
|
|
|
|
return 0; |
|
1603
|
|
|
|
|
|
|
}, |
|
1604
|
|
|
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
=item -bad_override => sub { ($handle, $key, @args) = @_; die "..." } |
|
1606
|
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
This allows you to override what happens when someone does a bad override (IE |
|
1608
|
|
|
|
|
|
|
-allow_override is set to false, and an override was attempted) |
|
1609
|
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
=item -hash => sub { my ($new_h, $hashref) = @_; ...; return $bool } |
|
1611
|
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
You can use this flag to provide alternate behavior for when an hashref is |
|
1613
|
|
|
|
|
|
|
provided as an argument. Normally it is treated as an WHERE. You can provide a |
|
1614
|
|
|
|
|
|
|
callback that implements alternate behavior. Your callback will receive the new |
|
1615
|
|
|
|
|
|
|
handle and the arg as arguments. The sub should return true if the alternate |
|
1616
|
|
|
|
|
|
|
behavior handled the argument, it should return false to fallback to the |
|
1617
|
|
|
|
|
|
|
default behavior of treating it as an WHERE. |
|
1618
|
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
-hash => sub { |
|
1620
|
|
|
|
|
|
|
my ($new_h, $hashref) = @_; |
|
1621
|
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
$did_alternate_behavior = ...; |
|
1623
|
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
return 1 if $did_alternate_behavior; |
|
1625
|
|
|
|
|
|
|
return 0; |
|
1626
|
|
|
|
|
|
|
}, |
|
1627
|
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
=item -integer |
|
1629
|
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
You can use this flag to provide alternate behavior for when an integer is |
|
1631
|
|
|
|
|
|
|
provided as an argument. Normally it is treated as a LIMIT. You can provide a |
|
1632
|
|
|
|
|
|
|
callback that implements alternate behavior. Your callback will receive the new |
|
1633
|
|
|
|
|
|
|
handle and the arg as arguments. The sub should return true if the alternate |
|
1634
|
|
|
|
|
|
|
behavior handled the argument, it should return false to fallback to the |
|
1635
|
|
|
|
|
|
|
default behavior of treating it as a LIMIT. |
|
1636
|
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
-integer => sub { |
|
1638
|
|
|
|
|
|
|
my ($new_h, $integer) = @_; |
|
1639
|
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
$did_alternate_behavior = ...; |
|
1641
|
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
return 1 if $did_alternate_behavior; |
|
1643
|
|
|
|
|
|
|
return 0; |
|
1644
|
|
|
|
|
|
|
}, |
|
1645
|
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
=item -row_and_source => sub { my ($h) = @_; die "..." } |
|
1647
|
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
What to do when someone provides both a row, and a source that does not match |
|
1649
|
|
|
|
|
|
|
the rows source. Normally it throws an exception. |
|
1650
|
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
=item -row_and_where => sub { my ($h) = @_; die "..." } |
|
1652
|
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
What to do when someone provides both a row, and a WHERE condition. Normally an |
|
1654
|
|
|
|
|
|
|
exception is thrown. |
|
1655
|
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
=item -scalar => sub { my ($h, $arg, $args) = @_; ...; return $bool } |
|
1657
|
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
This provides an opportunity to override what is done if a scalar argument is |
|
1659
|
|
|
|
|
|
|
encountered. Return false to fallback to original behavior. |
|
1660
|
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
This is a place to inject custom C<< my_arg => $my_val >> options for the |
|
1662
|
|
|
|
|
|
|
constructor to process. |
|
1663
|
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
=item -unknown_arg => sub { my ($h, $arg) = @_; die ... } |
|
1665
|
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
=item -unknown_object => sub { my ($h, $arg) = @_; die ... } |
|
1667
|
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
=item -unknown_ref => sub { my ($h, $arg) = @_; die ... } |
|
1669
|
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
These allow custom handlers for unknown arguments. The defaults throw |
|
1671
|
|
|
|
|
|
|
exceptions. |
|
1672
|
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
=back |
|
1674
|
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
=head2 SHORTCUTS |
|
1676
|
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
=over 4 |
|
1678
|
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
=item $dialect = $h->dialect |
|
1680
|
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
Return the L<DBIx::QuickORM::Dialect> object. |
|
1682
|
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
=back |
|
1684
|
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
=head2 Joining |
|
1686
|
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
=over 4 |
|
1688
|
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
=item $new_h = $h->join(@args) |
|
1690
|
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
Used to create a join handle. |
|
1692
|
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
=item $new_h = $h->left_join(@args) |
|
1694
|
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
=item $new_h = $h->right_join(@args) |
|
1696
|
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
=item $new_h = $h->inner_join(@args) |
|
1698
|
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
=item $new_h = $h->full_join(@args) |
|
1700
|
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
=item $new_h = $h->cross_join(@args) |
|
1702
|
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
These are all shortcuts for: |
|
1704
|
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
$new_h = $h->join(type => $DIRECTION, @args); |
|
1706
|
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
Then you can get L<DBIx::QuickORM::Join::Row> objects: |
|
1708
|
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
my $jrow = $h->first; |
|
1710
|
|
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
my @jrows = $h->all; |
|
1712
|
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
=back |
|
1714
|
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
Here is an example, here is some schema: |
|
1716
|
|
|
|
|
|
|
|
|
1717
|
|
|
|
|
|
|
CREATE TABLE foo ( |
|
1718
|
|
|
|
|
|
|
foo_id SERIAL NOT NULL PRIMARY KEY, |
|
1719
|
|
|
|
|
|
|
name VARCHAR(20) NOT NULL, |
|
1720
|
|
|
|
|
|
|
UNIQUE(name) |
|
1721
|
|
|
|
|
|
|
); |
|
1722
|
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
CREATE TABLE bar ( |
|
1724
|
|
|
|
|
|
|
bar_id SERIAL NOT NULL PRIMARY KEY, |
|
1725
|
|
|
|
|
|
|
name VARCHAR(20) NOT NULL, |
|
1726
|
|
|
|
|
|
|
foo_id INTEGER DEFAULT NULL REFERENCES foo(foo_id), |
|
1727
|
|
|
|
|
|
|
UNIQUE(name) |
|
1728
|
|
|
|
|
|
|
); |
|
1729
|
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
CREATE TABLE baz ( |
|
1731
|
|
|
|
|
|
|
baz_id SERIAL NOT NULL PRIMARY KEY, |
|
1732
|
|
|
|
|
|
|
name VARCHAR(20) NOT NULL, |
|
1733
|
|
|
|
|
|
|
foo_id INTEGER DEFAULT NULL REFERENCES foo(foo_id), |
|
1734
|
|
|
|
|
|
|
bar_id INTEGER DEFAULT NULL REFERENCES bar(bar_id), |
|
1735
|
|
|
|
|
|
|
UNIQUE(name) |
|
1736
|
|
|
|
|
|
|
); |
|
1737
|
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
Define the ORM: |
|
1739
|
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
orm my_orm => sub { |
|
1741
|
|
|
|
|
|
|
db 'mydb'; |
|
1742
|
|
|
|
|
|
|
autofill sub { |
|
1743
|
|
|
|
|
|
|
autorow 'My::Test::Row'; |
|
1744
|
|
|
|
|
|
|
}; |
|
1745
|
|
|
|
|
|
|
}; |
|
1746
|
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
Insert some data and use join: |
|
1748
|
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
my $con = orm('my_orm'); |
|
1750
|
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
# Insert a row into foo |
|
1752
|
|
|
|
|
|
|
my $foo_a = $con->insert(foo => {name => 'a'}); |
|
1753
|
|
|
|
|
|
|
|
|
1754
|
|
|
|
|
|
|
# Insert 3 rows into bar that link to foo. |
|
1755
|
|
|
|
|
|
|
my $bar_a1 = $con->insert(bar => {name => 'a1', foo_id => $foo_a->foo_id}); |
|
1756
|
|
|
|
|
|
|
my $bar_a2 = $con->insert(bar => {name => 'a2', foo_id => $foo_a->foo_id}); |
|
1757
|
|
|
|
|
|
|
my $bar_a3 = $con->insert(bar => {name => 'a3', foo_id => $foo_a->foo_id}); |
|
1758
|
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
# Insert a row into baz linked to foo_a and bar_a1 |
|
1760
|
|
|
|
|
|
|
my $baz = $con->insert(baz => {name => 'a', foo_id => $foo_a->foo_id, bar_id => $bar_a1->bar_id}); |
|
1761
|
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
my $h = $con->handle('foo')->left_join('bar')->left_join('baz', from => 'foo')->order_by(qw/a.foo_id b.bar_id c.baz_id/); |
|
1763
|
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
The handle can be used to fetch L<DBIx::QuickORM::Join::Row> instances, that lets you get each component row object by alias: |
|
1765
|
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
my $one = $iter->first; |
|
1767
|
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
Getting component rows using C<by_alias()> will return regular row objects, |
|
1769
|
|
|
|
|
|
|
they will be the same references if the rows have already been fetched and are |
|
1770
|
|
|
|
|
|
|
in memory/cache. |
|
1771
|
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
use Test2::V0 qw/ref_is/; |
|
1773
|
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
ref_is($one->by_alias('a'), $foo_a, "Got the foo_a reference"); |
|
1775
|
|
|
|
|
|
|
ref_is($one->by_alias('b'), $bar_a1, "Got the bar_a reference"); |
|
1776
|
|
|
|
|
|
|
ref_is($one->by_alias('c'), $baz, "Got the baz reference"); |
|
1777
|
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
You can also directly access fields: |
|
1779
|
|
|
|
|
|
|
|
|
1780
|
|
|
|
|
|
|
my $a_name = $one->field('a.name'); |
|
1781
|
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
=head2 Immutators |
|
1783
|
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
These always return a new handle instance with a state that copies the original |
|
1785
|
|
|
|
|
|
|
except where arguments would mutate it. The original handle is never modified. |
|
1786
|
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
=over 4 |
|
1788
|
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=item $new_h = $h->auto_refresh() |
|
1790
|
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
=item $new_h = $h->no_auto_refresh() |
|
1792
|
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
Toggle auto_refresh on and off. |
|
1794
|
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
auto_refresh applies only to insert operations. If true then all row fields |
|
1796
|
|
|
|
|
|
|
will be refreshed from the database after the insert is complete. Without |
|
1797
|
|
|
|
|
|
|
auto_refresh only the primary key fields are pulled from the database |
|
1798
|
|
|
|
|
|
|
post-insert, the rest of the fields in the row are assumed to contain the |
|
1799
|
|
|
|
|
|
|
values used for insert. The auto-refresh behavior is desirable if triggers or |
|
1800
|
|
|
|
|
|
|
other behaviors might modify the data once it is inserted. |
|
1801
|
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
=item $new_h = $h->sync() |
|
1803
|
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
Turn off async, aside, and forked flags returning a synchronous handle. |
|
1805
|
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
=item $new_h = $h->async() |
|
1807
|
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
The newly returned handle will run async operations. |
|
1809
|
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
=item $new_h = $h->aside() |
|
1811
|
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
The newly returned handle will run aside operations (async, but with a seperate |
|
1813
|
|
|
|
|
|
|
DB connection) |
|
1814
|
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
=item $new_h = $h->forked() |
|
1816
|
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
The newly returned handle will run 'forked' operartions. This means the query |
|
1818
|
|
|
|
|
|
|
is executed in a forked process with a new db connection, the results will be |
|
1819
|
|
|
|
|
|
|
returned to the parent. |
|
1820
|
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
This can be used to emulate async operations on databases that do not support |
|
1822
|
|
|
|
|
|
|
them, such as L<DBD::SQlite>. |
|
1823
|
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
=item $new_h = $h->data_only() |
|
1825
|
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
The newly returned handle will return hashrefs instead of blessed row objects. |
|
1827
|
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
=item $new_h = $h->all_fields() |
|
1829
|
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
Make sure the handle selects all fields when fetching rows. Normally some rows |
|
1831
|
|
|
|
|
|
|
may be omitted by default based on if they have an C<omit> flag set. |
|
1832
|
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
=item $new_h = $h->and($WHERE) |
|
1834
|
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
Create a new handle that has a union of the original WHERE clause and the additional WHERE clause |
|
1836
|
|
|
|
|
|
|
|
|
1837
|
|
|
|
|
|
|
SELECT ... WHERE old_where AND new_where |
|
1838
|
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
=item $new_h = $h->or($WHERE) |
|
1840
|
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
Create a new handle that has a union of the original WHERE clause or the additional WHERE clause |
|
1842
|
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
SELECT ... WHERE old_where OR new_where |
|
1844
|
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
=item $new_h = $h->internal_txns() |
|
1846
|
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
=item $new_h = $h->internal_transactions() |
|
1848
|
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
Enable internal transactions. These are mainly used in cases where an operation |
|
1850
|
|
|
|
|
|
|
needs multiple queries. |
|
1851
|
|
|
|
|
|
|
|
|
1852
|
|
|
|
|
|
|
=item $new_h = $h->no_internal_txns() |
|
1853
|
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
=item $new_h = $h->no_internal_transactions() |
|
1855
|
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
Disable internal transactions. These are mainly used in cases where an operation |
|
1857
|
|
|
|
|
|
|
needs multiple queries. |
|
1858
|
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
=back |
|
1860
|
|
|
|
|
|
|
|
|
1861
|
|
|
|
|
|
|
=head2 Immucessors |
|
1862
|
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
These are methods that return their value if called without arguments, but |
|
1864
|
|
|
|
|
|
|
return a clone of the handle with the new value set when provided with an |
|
1865
|
|
|
|
|
|
|
argument. |
|
1866
|
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
=over 4 |
|
1868
|
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
=item $sql_builder = $h->sql_builder() |
|
1870
|
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
=item $new_h = $h->sql_builder($sql_builder) |
|
1872
|
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
Can be used to get the SQL Builder that is already set, or create a clone fo |
|
1874
|
|
|
|
|
|
|
the handle with a new sql_builder set. |
|
1875
|
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
=item $connection = $h->connection() |
|
1877
|
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
=item $new_h = $h->connection($connection) |
|
1879
|
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
Can be used to get the connection of a handle, or to create a clone of the |
|
1881
|
|
|
|
|
|
|
handle that uses a new connection. |
|
1882
|
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
=item $source = $h->source() |
|
1884
|
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
=item $new_h = $h->source($source) |
|
1886
|
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
Can be used to get the connection of a source, or to create a clone of the |
|
1888
|
|
|
|
|
|
|
source that uses a new connection. |
|
1889
|
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
=item $row = $h->row() |
|
1891
|
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
=item $new_h = $h->row($row) |
|
1893
|
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
Can be used to get the connection of a row, or to create a clone of the |
|
1895
|
|
|
|
|
|
|
row that uses a new connection. |
|
1896
|
|
|
|
|
|
|
|
|
1897
|
|
|
|
|
|
|
=item $fields = $h->fields() |
|
1898
|
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
=item $new_h = $h->fields(\@fields) |
|
1900
|
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
Can be used to get the fields of a handle, or to create a clone of the |
|
1902
|
|
|
|
|
|
|
handle that uses the new fields. |
|
1903
|
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
=item $omit = $h->omit() |
|
1905
|
|
|
|
|
|
|
|
|
1906
|
|
|
|
|
|
|
=item $new_h = $h->omit(\@omit) |
|
1907
|
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
Can be used to get the omitted fields of a handle, or to create a clone of the |
|
1909
|
|
|
|
|
|
|
handle that uses the new omitted fields. |
|
1910
|
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
=item $limit = $h->limit() |
|
1912
|
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
=item $new_h = $h->limit($limit) |
|
1914
|
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
Can be used to get the limit of a handle, or to create a clone of the |
|
1916
|
|
|
|
|
|
|
handle that uses the new limit. |
|
1917
|
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
=item $where = $h->where() |
|
1919
|
|
|
|
|
|
|
|
|
1920
|
|
|
|
|
|
|
=item $new_h = $h->where($where) |
|
1921
|
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
Can be used to get the where condition of a handle, or to create a clone of the |
|
1923
|
|
|
|
|
|
|
handle that uses the new where condition. |
|
1924
|
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
=item $order_by = $h->order_by() |
|
1926
|
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
=item $new_h = $h->order_by(\@order_by) |
|
1928
|
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
Can be used to get the order_by of a handle, or to create a clone of the |
|
1930
|
|
|
|
|
|
|
handle that uses the new order_by. |
|
1931
|
|
|
|
|
|
|
|
|
1932
|
|
|
|
|
|
|
=back |
|
1933
|
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
=head2 State Accessors |
|
1935
|
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
=over 4 |
|
1937
|
|
|
|
|
|
|
|
|
1938
|
|
|
|
|
|
|
=item $bool = $h->is_sync |
|
1939
|
|
|
|
|
|
|
|
|
1940
|
|
|
|
|
|
|
True if the handle is synchronous. |
|
1941
|
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
=item $bool = $h->is_async |
|
1943
|
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
True if the handle is async. |
|
1945
|
|
|
|
|
|
|
|
|
1946
|
|
|
|
|
|
|
=item $bool = $h->is_aside |
|
1947
|
|
|
|
|
|
|
|
|
1948
|
|
|
|
|
|
|
True if the handle uses 'aside' operations (async but on a seperate db |
|
1949
|
|
|
|
|
|
|
connection). |
|
1950
|
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
=item $bool = $h->is_forked |
|
1952
|
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
True if the handle uses 'forked' operations, (queries run in a child process on |
|
1954
|
|
|
|
|
|
|
a second connection). |
|
1955
|
|
|
|
|
|
|
|
|
1956
|
|
|
|
|
|
|
=item $bool = $h->using_internal_transactions |
|
1957
|
|
|
|
|
|
|
|
|
1958
|
|
|
|
|
|
|
True if the handle is allowed to use internal transactions. |
|
1959
|
|
|
|
|
|
|
|
|
1960
|
|
|
|
|
|
|
=back |
|
1961
|
|
|
|
|
|
|
|
|
1962
|
|
|
|
|
|
|
=head2 Results Fetchers |
|
1963
|
|
|
|
|
|
|
|
|
1964
|
|
|
|
|
|
|
=over 4 |
|
1965
|
|
|
|
|
|
|
|
|
1966
|
|
|
|
|
|
|
=item $row = $h->by_id($id) |
|
1967
|
|
|
|
|
|
|
|
|
1968
|
|
|
|
|
|
|
=item $row = $h->by_id(\@id_vals) |
|
1969
|
|
|
|
|
|
|
|
|
1970
|
|
|
|
|
|
|
=item $row = $h->by_id({field => $val}) |
|
1971
|
|
|
|
|
|
|
|
|
1972
|
|
|
|
|
|
|
Fetch a row by ID. If the row is already in cache no database query is needed. |
|
1973
|
|
|
|
|
|
|
|
|
1974
|
|
|
|
|
|
|
=item $h->by_ids(@ids) |
|
1975
|
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
A convenience method for fetching several rows by ID. See C<by_id()> above for |
|
1977
|
|
|
|
|
|
|
ID formats. |
|
1978
|
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
=item $row = $h->vivify(\%ROW_DATA) |
|
1980
|
|
|
|
|
|
|
|
|
1981
|
|
|
|
|
|
|
Create a row object witht he provided data. The Row will NOT be inserted into |
|
1982
|
|
|
|
|
|
|
the database unless you call C<< $row->insert >> or C<< $row->save >>. |
|
1983
|
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
=item $row = $h->insert(\%ROW_DATA) |
|
1985
|
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
Insert the data into the database and return a proper row object for it. |
|
1987
|
|
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
|
=item $row = $h->insert_and_refresh(\%ROW_DATA) |
|
1989
|
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
Insert the data into the database and return a proper row object. The row will |
|
1991
|
|
|
|
|
|
|
be refreshed to contain the actual stored data, including data modified by |
|
1992
|
|
|
|
|
|
|
triggers. If the database supports 'returning on insert' then that will be |
|
1993
|
|
|
|
|
|
|
used, otherwise the insert and fetch operations are wrapped in a single |
|
1994
|
|
|
|
|
|
|
transaction, unless internal transactions are disabled in which case an |
|
1995
|
|
|
|
|
|
|
exception may be thrown. |
|
1996
|
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
=item $h->update(\%CHANGES) |
|
1998
|
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
Apply the changes (field names and new values) to all rows matching the where condition. |
|
2000
|
|
|
|
|
|
|
|
|
2001
|
|
|
|
|
|
|
=item $h->update($row_obj) |
|
2002
|
|
|
|
|
|
|
|
|
2003
|
|
|
|
|
|
|
Write pending changes to the row. |
|
2004
|
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
=item $row = $h->upsert(\%ROW_DATA) |
|
2006
|
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
=item $row = $h->upsert_and_refresh(\%ROW_DATA) |
|
2008
|
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
These will either insert or update the row depending on if it already exists in |
|
2010
|
|
|
|
|
|
|
the database. |
|
2011
|
|
|
|
|
|
|
|
|
2012
|
|
|
|
|
|
|
Depending on SQL dialect it will usually result in a sql statement like one of these: |
|
2013
|
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
INSERT INTO example (id, name) VALUES (?, ?) ON CONFLICT(id) DO UPDATE SET name = ? RETURNING id |
|
2015
|
|
|
|
|
|
|
INSERT INTO example (id, name) VALUES (?, ?) ON DUPLICATE KEY UPDATE name = ? RETURNING id |
|
2016
|
|
|
|
|
|
|
INSERT INTO example (id, name) VALUES (?, ?) ON DUPLICATE KEY UPDATE name = ? |
|
2017
|
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
=item $h->delete |
|
2019
|
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
=item $h->delete($row) |
|
2021
|
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
=item $h->delete($where) |
|
2023
|
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
If no arguments are provided the handle will delete all applicable rows. |
|
2025
|
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
If a row is provided it will be deleted |
|
2027
|
|
|
|
|
|
|
|
|
2028
|
|
|
|
|
|
|
If a where clause is provided then all rows it would find will be deleted. |
|
2029
|
|
|
|
|
|
|
|
|
2030
|
|
|
|
|
|
|
If a row or where condition are provided they will override any that are |
|
2031
|
|
|
|
|
|
|
already associated with the handle. |
|
2032
|
|
|
|
|
|
|
|
|
2033
|
|
|
|
|
|
|
=item $row = $h->one() |
|
2034
|
|
|
|
|
|
|
|
|
2035
|
|
|
|
|
|
|
Return a row matching the conditions on the handle, if any. Will return undef |
|
2036
|
|
|
|
|
|
|
if there are no matching rows. Will throw an exception if the query returns |
|
2037
|
|
|
|
|
|
|
more than 1 row. |
|
2038
|
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
In dat_only mode this will return the hashref of the returned row. |
|
2040
|
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
=item $row = $h->first() |
|
2042
|
|
|
|
|
|
|
|
|
2043
|
|
|
|
|
|
|
Similar to one() above, but will not die if more than 1 row matches the query. |
|
2044
|
|
|
|
|
|
|
|
|
2045
|
|
|
|
|
|
|
In dat_only mode this will return the hashref of the returned row. |
|
2046
|
|
|
|
|
|
|
|
|
2047
|
|
|
|
|
|
|
=item @rows = $h->all |
|
2048
|
|
|
|
|
|
|
|
|
2049
|
|
|
|
|
|
|
Return all matching rows. |
|
2050
|
|
|
|
|
|
|
|
|
2051
|
|
|
|
|
|
|
This cannot be used in async mode, use iterator() instead as it provides |
|
2052
|
|
|
|
|
|
|
mechanisms to check if the async query is ready. |
|
2053
|
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
In data_only mode this will return a list of hashrefs instead of blessed row |
|
2055
|
|
|
|
|
|
|
objects. |
|
2056
|
|
|
|
|
|
|
|
|
2057
|
|
|
|
|
|
|
=item my $iter = $h->iterator |
|
2058
|
|
|
|
|
|
|
|
|
2059
|
|
|
|
|
|
|
Returns an L<DBIx::QuickORM::Iterator> object that can be used to iterate over all rows. |
|
2060
|
|
|
|
|
|
|
|
|
2061
|
|
|
|
|
|
|
my $iter = $h->iterator; |
|
2062
|
|
|
|
|
|
|
while (my $row = $iter->next) { |
|
2063
|
|
|
|
|
|
|
...; |
|
2064
|
|
|
|
|
|
|
} |
|
2065
|
|
|
|
|
|
|
|
|
2066
|
|
|
|
|
|
|
If used in data_only mode then the rows will be hashrefs instead of blessed |
|
2067
|
|
|
|
|
|
|
objects. |
|
2068
|
|
|
|
|
|
|
|
|
2069
|
|
|
|
|
|
|
In Async mode the iterator will heve a C<< $iter->ready() >> method you can use |
|
2070
|
|
|
|
|
|
|
to check if the query is ready. For sync queries C<ready()> will always return |
|
2071
|
|
|
|
|
|
|
true. |
|
2072
|
|
|
|
|
|
|
|
|
2073
|
|
|
|
|
|
|
=item $number = $h->count |
|
2074
|
|
|
|
|
|
|
|
|
2075
|
|
|
|
|
|
|
Get the number of rows that the query would return. |
|
2076
|
|
|
|
|
|
|
|
|
2077
|
|
|
|
|
|
|
=item $h->iterate(sub { my $row = shift; ... }) |
|
2078
|
|
|
|
|
|
|
|
|
2079
|
|
|
|
|
|
|
Run the callback for each row found. |
|
2080
|
|
|
|
|
|
|
|
|
2081
|
|
|
|
|
|
|
In data_only mode this will provide hashrefs instead of blessed row objects. |
|
2082
|
|
|
|
|
|
|
|
|
2083
|
|
|
|
|
|
|
=back |
|
2084
|
|
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
|
=head1 SOURCE |
|
2086
|
|
|
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
The source code repository for DBIx-QuickORM can be found at |
|
2088
|
|
|
|
|
|
|
L<http://github.com/exodist/DBIx-QuickORM/>. |
|
2089
|
|
|
|
|
|
|
|
|
2090
|
|
|
|
|
|
|
=head1 MAINTAINERS |
|
2091
|
|
|
|
|
|
|
|
|
2092
|
|
|
|
|
|
|
=over 4 |
|
2093
|
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
=item Chad Granum E<lt>exodist@cpan.orgE<gt> |
|
2095
|
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
=back |
|
2097
|
|
|
|
|
|
|
|
|
2098
|
|
|
|
|
|
|
=head1 AUTHORS |
|
2099
|
|
|
|
|
|
|
|
|
2100
|
|
|
|
|
|
|
=over 4 |
|
2101
|
|
|
|
|
|
|
|
|
2102
|
|
|
|
|
|
|
=item Chad Granum E<lt>exodist@cpan.orgE<gt> |
|
2103
|
|
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
|
=back |
|
2105
|
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
2107
|
|
|
|
|
|
|
|
|
2108
|
|
|
|
|
|
|
Copyright Chad Granum E<lt>exodist7@gmail.comE<gt>. |
|
2109
|
|
|
|
|
|
|
|
|
2110
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
|
2111
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
|
2112
|
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
See L<http://dev.perl.org/licenses/> |
|
2114
|
|
|
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
=cut |