File Coverage

blib/lib/DBIx/QuickORM/Handle.pm
Criterion Covered Total %
statement 498 740 67.3
branch 219 484 45.2
condition 53 170 31.1
subroutine 69 109 63.3
pod 52 54 96.3
total 891 1557 57.2


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