Remove dead code commented out since 2006 ( 953a18ef )
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage.pm
CommitLineData
4012acd8 1package DBIx::Class::Storage;
a62cf8d4 2
3use strict;
4use warnings;
5
046ad905 6use base qw/DBIx::Class/;
2ad62d97 7use mro 'c3';
046ad905 8
90d7422f 9{
10 package # Hide from PAUSE
11 DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
12 use base 'DBIx::Class::Exception';
13}
14
15use DBIx::Class::Carp;
9345b14c 16use DBIx::Class::Storage::BlockRunner;
90d7422f 17use Scalar::Util qw/blessed weaken/;
1bc193ac 18use DBIx::Class::Storage::TxnScopeGuard;
f43ea814 19use Try::Tiny;
fd323bf1 20use namespace::clean;
046ad905 21
90d7422f 22__PACKAGE__->mk_group_accessors(simple => qw/debug schema transaction_depth auto_savepoint savepoints/);
23__PACKAGE__->mk_group_accessors(component_class => 'cursor_class');
e4eb8ee1 24
25__PACKAGE__->cursor_class('DBIx::Class::Cursor');
26
27sub cursor { shift->cursor_class(@_); }
046ad905 28
046ad905 29=head1 NAME
30
31DBIx::Class::Storage - Generic Storage Handler
32
33=head1 DESCRIPTION
34
35A base implementation of common Storage methods. For specific
36information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.
37
38=head1 METHODS
39
40=head2 new
41
42Arguments: $schema
43
44Instantiates the Storage object.
45
46=cut
47
48sub new {
49 my ($self, $schema) = @_;
50
51 $self = ref $self if ref $self;
52
90d7422f 53 my $new = bless( {
90d7422f 54 savepoints => [],
55 }, $self);
046ad905 56
57 $new->set_schema($schema);
4d753fb8 58 $new->debug(1)
59 if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
046ad905 60
61 $new;
62}
63
64=head2 set_schema
65
66Used to reset the schema class or object which owns this
67storage object, such as during L<DBIx::Class::Schema/clone>.
68
69=cut
70
71sub set_schema {
72 my ($self, $schema) = @_;
73 $self->schema($schema);
6298a324 74 weaken $self->{schema} if ref $self->{schema};
046ad905 75}
76
77=head2 connected
78
79Returns true if we have an open storage connection, false
80if it is not (yet) open.
81
82=cut
83
a62cf8d4 84sub connected { die "Virtual method!" }
046ad905 85
86=head2 disconnect
87
88Closes any open storage connection unconditionally.
89
90=cut
91
92sub disconnect { die "Virtual method!" }
93
94=head2 ensure_connected
95
96Initiate a connection to the storage if one isn't already open.
97
98=cut
99
a62cf8d4 100sub ensure_connected { die "Virtual method!" }
046ad905 101
102=head2 throw_exception
103
104Throws an exception - croaks.
105
106=cut
107
108sub throw_exception {
109 my $self = shift;
110
2a2a7b23 111 if (ref $self and $self->schema) {
1a58752c 112 $self->schema->throw_exception(@_);
113 }
114 else {
115 DBIx::Class::Exception->throw(@_);
116 }
046ad905 117}
a62cf8d4 118
4012acd8 119=head2 txn_do
a62cf8d4 120
4012acd8 121=over 4
a62cf8d4 122
4012acd8 123=item Arguments: C<$coderef>, @coderef_args?
a62cf8d4 124
4012acd8 125=item Return Value: The return value of $coderef
126
127=back
128
129Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
130returning its result (if any). If an exception is caught, a rollback is issued
131and the exception is rethrown. If the rollback fails, (i.e. throws an
132exception) an exception is thrown that includes a "Rollback failed" message.
133
134For example,
135
136 my $author_rs = $schema->resultset('Author')->find(1);
137 my @titles = qw/Night Day It/;
138
139 my $coderef = sub {
140 # If any one of these fails, the entire transaction fails
141 $author_rs->create_related('books', {
142 title => $_
143 }) foreach (@titles);
144
145 return $author->books;
146 };
147
148 my $rs;
20674fcd 149 try {
4012acd8 150 $rs = $schema->txn_do($coderef);
20674fcd 151 } catch {
6b89ee0b 152 my $error = shift;
20674fcd 153 # Transaction failed
90d7422f 154 die "something terrible has happened!"
6b89ee0b 155 if ($error =~ /Rollback failed/); # Rollback failed
4012acd8 156
157 deal_with_failed_transaction();
20674fcd 158 };
4012acd8 159
160In a nested transaction (calling txn_do() from within a txn_do() coderef) only
161the outermost transaction will issue a L</txn_commit>, and txn_do() can be
162called in void, scalar and list context and it will behave as expected.
163
05075aee 164Please note that all of the code in your coderef, including non-DBIx::Class
165code, is part of a transaction. This transaction may fail out halfway, or
166it may get partially double-executed (in the case that our DB connection
167failed halfway through the transaction, in which case we reconnect and
168restart the txn). Therefore it is best that any side-effects in your coderef
169are idempotent (that is, can be re-executed multiple times and get the
170same result), and that you check up on your side-effects in the case of
171transaction failure.
6500d50f 172
4012acd8 173=cut
174
175sub txn_do {
38ed54cd 176 my $self = shift;
4012acd8 177
9345b14c 178 DBIx::Class::Storage::BlockRunner->new(
179 storage => $self,
9345b14c 180 wrap_txn => 1,
7d534e68 181 retry_handler => sub {
182 $_[0]->failed_attempt_count == 1
183 and
184 ! $_[0]->storage->connected
185 },
186 )->run(@_);
a62cf8d4 187}
188
046ad905 189=head2 txn_begin
190
191Starts a transaction.
192
193See the preferred L</txn_do> method, which allows for
194an entire code block to be executed transactionally.
195
196=cut
197
90d7422f 198sub txn_begin {
199 my $self = shift;
200
201 if($self->transaction_depth == 0) {
202 $self->debugobj->txn_begin()
203 if $self->debug;
204 $self->_exec_txn_begin;
205 }
206 elsif ($self->auto_savepoint) {
207 $self->svp_begin;
208 }
209 $self->{transaction_depth}++;
210
211}
046ad905 212
213=head2 txn_commit
214
215Issues a commit of the current transaction.
216
be01f1be 217It does I<not> perform an actual storage commit unless there's a DBIx::Class
218transaction currently in effect (i.e. you called L</txn_begin>).
219
046ad905 220=cut
221
90d7422f 222sub txn_commit {
223 my $self = shift;
224
225 if ($self->transaction_depth == 1) {
226 $self->debugobj->txn_commit() if $self->debug;
227 $self->_exec_txn_commit;
228 $self->{transaction_depth}--;
398215b1 229 $self->savepoints([]);
90d7422f 230 }
231 elsif($self->transaction_depth > 1) {
232 $self->{transaction_depth}--;
233 $self->svp_release if $self->auto_savepoint;
234 }
235 else {
236 $self->throw_exception( 'Refusing to commit without a started transaction' );
237 }
238}
046ad905 239
240=head2 txn_rollback
241
242Issues a rollback of the current transaction. A nested rollback will
243throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
244which allows the rollback to propagate to the outermost transaction.
245
246=cut
247
90d7422f 248sub txn_rollback {
249 my $self = shift;
250
251 if ($self->transaction_depth == 1) {
252 $self->debugobj->txn_rollback() if $self->debug;
90d7422f 253 $self->{transaction_depth}--;
729656c5 254
255 # in case things get really hairy - just disconnect
256 eval { $self->_exec_txn_rollback; 1 } or do {
257 my $rollback_error = $@;
258
259 # whatever happens, too low down the stack to care
260 # FIXME - revisit if stackable exceptions become a thing
261 eval { $self->disconnect };
262
263 die $rollback_error;
264 };
265
398215b1 266 $self->savepoints([]);
90d7422f 267 }
268 elsif ($self->transaction_depth > 1) {
269 $self->{transaction_depth}--;
270
271 if ($self->auto_savepoint) {
272 $self->svp_rollback;
273 $self->svp_release;
274 }
275 else {
276 DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->throw(
277 "A txn_rollback in nested transaction is ineffective! (depth $self->{transaction_depth})"
278 );
279 }
280 }
281 else {
282 $self->throw_exception( 'Refusing to roll back without a started transaction' );
283 }
284}
046ad905 285
84efb6d7 286# to be called by several internal stacked transaction handler codepaths
287# not for external consumption
288# *DOES NOT* throw exceptions, instead:
289# - returns false on success
290# - returns the exception on failed rollback
291sub __delicate_rollback {
292 my $self = shift;
293
294 if (
729656c5 295 ( $self->transaction_depth || 0 ) > 1
84efb6d7 296 and
297 # FIXME - the autosvp check here shouldn't be happening, it should be a role-ish thing
298 # The entire concept needs to be rethought with the storage layer... or something
299 ! $self->auto_savepoint
300 and
301 # the handle seems healthy, and there is nothing for us to do with it
302 # just go ahead and bow out, without triggering the txn_rollback() "nested exception"
303 # the unwind will eventually fail somewhere higher up if at all
304 # FIXME: a ::Storage::DBI-specific method, not a generic ::Storage one
305 $self->_seems_connected
306 ) {
307 # all above checks out - there is nothing to do on the $dbh itself
308 # just a plain soft-decrease of depth
309 $self->{transaction_depth}--;
310 return;
311 }
312
313 my $rbe;
314
315 local $@; # taking no chances
316 unless( eval { $self->txn_rollback; 1 } ) {
317
318 $rbe = $@;
319
320 # we were passed an existing exception to augment (think DESTROY stacks etc)
321 if (@_) {
322 my $exception = shift;
323
324 # append our text - THIS IS A TEMPORARY FIXUP!
325 #
326 # If the passed in exception is a reference, or an object we don't know
327 # how to augment - flattening it is just damn rude
328 if (
329 # FIXME - a better way, not liable to destroy an existing exception needs
330 # to be created. For the time being perpetuating the sin below in order
331 # to break the deadlock of which yak is being shaved first
332 0
333 and
334 length ref $$exception
335 and
336 (
337 ! defined blessed $$exception
338 or
339 ! $$exception->isa( 'DBIx::Class::Exception' )
340 )
341 ) {
342
343 ##################
344 ### FIXME - TODO
345 ##################
346
347 }
348 else {
349
350 # SUCH HIDEOUS, MUCH AUGH! (and double WOW on the s/// at the end below)
351 $rbe =~ s/ at .+? line \d+$//;
352
353 (
354 (
355 defined blessed $$exception
356 and
357 $$exception->isa( 'DBIx::Class::Exception' )
358 )
359 ? (
360 $$exception->{msg} =
361 "Transaction aborted: $$exception->{msg}. Rollback failed: $rbe"
362 )
363 : (
364 $$exception =
365 "Transaction aborted: $$exception. Rollback failed: $rbe"
366 )
367 ) =~ s/Transaction aborted: (?=Transaction aborted:)//;
368 }
369 }
370 }
371
372 return $rbe;
373}
374
adb3554a 375=head2 svp_begin
376
360dc8a5 377Arguments: $savepoint_name?
adb3554a 378
360dc8a5 379Created a new savepoint using the name provided as argument. If no name
380is provided, a random name will be used.
adb3554a 381
382=cut
383
90d7422f 384sub svp_begin {
385 my ($self, $name) = @_;
386
387 $self->throw_exception ("You can't use savepoints outside a transaction")
388 unless $self->transaction_depth;
389
390 my $exec = $self->can('_exec_svp_begin')
391 or $self->throw_exception ("Your Storage implementation doesn't support savepoints");
392
393 $name = $self->_svp_generate_name
394 unless defined $name;
395
396 push @{ $self->{savepoints} }, $name;
397
398 $self->debugobj->svp_begin($name) if $self->debug;
399
400 $exec->($self, $name);
401}
402
403sub _svp_generate_name {
404 my ($self) = @_;
405 return 'savepoint_'.scalar(@{ $self->{'savepoints'} });
406}
407
adb3554a 408
409=head2 svp_release
410
360dc8a5 411Arguments: $savepoint_name?
adb3554a 412
360dc8a5 413Release the savepoint provided as argument. If none is provided,
414release the savepoint created most recently. This will implicitly
415release all savepoints created after the one explicitly released as well.
adb3554a 416
417=cut
418
90d7422f 419sub svp_release {
420 my ($self, $name) = @_;
421
422 $self->throw_exception ("You can't use savepoints outside a transaction")
423 unless $self->transaction_depth;
424
425 my $exec = $self->can('_exec_svp_release')
426 or $self->throw_exception ("Your Storage implementation doesn't support savepoints");
427
428 if (defined $name) {
429 my @stack = @{ $self->savepoints };
430 my $svp;
431
432 do { $svp = pop @stack } until $svp eq $name;
433
434 $self->throw_exception ("Savepoint '$name' does not exist")
435 unless $svp;
436
437 $self->savepoints(\@stack); # put back what's left
438 }
439 else {
440 $name = pop @{ $self->savepoints }
441 or $self->throw_exception('No savepoints to release');;
442 }
443
444 $self->debugobj->svp_release($name) if $self->debug;
445
446 $exec->($self, $name);
447}
adb3554a 448
449=head2 svp_rollback
450
360dc8a5 451Arguments: $savepoint_name?
adb3554a 452
360dc8a5 453Rollback to the savepoint provided as argument. If none is provided,
454rollback to the savepoint created most recently. This will implicitly
455release all savepoints created after the savepoint we rollback to.
adb3554a 456
457=cut
458
90d7422f 459sub svp_rollback {
460 my ($self, $name) = @_;
461
462 $self->throw_exception ("You can't use savepoints outside a transaction")
463 unless $self->transaction_depth;
464
465 my $exec = $self->can('_exec_svp_rollback')
466 or $self->throw_exception ("Your Storage implementation doesn't support savepoints");
467
468 if (defined $name) {
469 my @stack = @{ $self->savepoints };
470 my $svp;
471
472 # a rollback doesn't remove the named savepoint,
473 # only everything after it
474 while (@stack and $stack[-1] ne $name) {
475 pop @stack
476 };
477
478 $self->throw_exception ("Savepoint '$name' does not exist")
479 unless @stack;
480
481 $self->savepoints(\@stack); # put back what's left
482 }
483 else {
484 $name = $self->savepoints->[-1]
485 or $self->throw_exception('No savepoints to rollback');;
486 }
487
488 $self->debugobj->svp_rollback($name) if $self->debug;
489
490 $exec->($self, $name);
491}
adb3554a 492
11544e1d 493=head2 txn_scope_guard
3b7f3eac 494
11544e1d 495An alternative way of transaction handling based on
496L<DBIx::Class::Storage::TxnScopeGuard>:
1bc193ac 497
11544e1d 498 my $txn_guard = $storage->txn_scope_guard;
89028f42 499
47d7b769 500 $result->col1("val1");
501 $result->update;
89028f42 502
11544e1d 503 $txn_guard->commit;
89028f42 504
11544e1d 505If an exception occurs, or the guard object otherwise leaves the scope
506before C<< $txn_guard->commit >> is called, the transaction will be rolled
507back by an explicit L</txn_rollback> call. In essence this is akin to
508using a L</txn_begin>/L</txn_commit> pair, without having to worry
509about calling L</txn_rollback> at the right places. Note that since there
510is no defined code closure, there will be no retries and other magic upon
511database disconnection. If you need such functionality see L</txn_do>.
1bc193ac 512
513=cut
514
515sub txn_scope_guard {
516 return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
517}
518
046ad905 519=head2 sql_maker
520
521Returns a C<sql_maker> object - normally an object of class
d5dedbd6 522C<DBIx::Class::SQLMaker>.
046ad905 523
524=cut
525
526sub sql_maker { die "Virtual method!" }
527
528=head2 debug
529
f92a9d79 530Causes trace information to be emitted on the L</debugobj> object.
531(or C<STDERR> if L</debugobj> has not specifically been set).
046ad905 532
533This is the equivalent to setting L</DBIC_TRACE> in your
534shell environment.
535
536=head2 debugfh
537
4d93345c 538An opportunistic proxy to L<< ->debugobj->debugfh(@_)
539|DBIx::Class::Storage::Statistics/debugfh >>
540If the currently set L</debugobj> does not have a L</debugfh> method, caling
541this is a no-op.
046ad905 542
543=cut
544
545sub debugfh {
546 my $self = shift;
547
548 if ($self->debugobj->can('debugfh')) {
549 return $self->debugobj->debugfh(@_);
550 }
551}
552
553=head2 debugobj
554
555Sets or retrieves the object used for metric collection. Defaults to an instance
556of L<DBIx::Class::Storage::Statistics> that is compatible with the original
557method of using a coderef as a callback. See the aforementioned Statistics
558class for more information.
559
4d753fb8 560=cut
561
562sub debugobj {
563 my $self = shift;
564
565 if (@_) {
566 return $self->{debugobj} = $_[0];
567 }
568
569 $self->{debugobj} ||= do {
570 if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
571 require DBIx::Class::Storage::Debug::PrettyPrint;
6e102c8f 572 my @pp_args;
573
4d753fb8 574 if ($profile =~ /^\.?\//) {
575 require Config::Any;
576
577 my $cfg = try {
578 Config::Any->load_files({ files => [$profile], use_ext => 1 });
579 } catch {
580 # sanitize the error message a bit
581 $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x;
582 $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_");
583 };
584
6e102c8f 585 @pp_args = values %{$cfg->[0]};
4d753fb8 586 }
587 else {
6e102c8f 588 @pp_args = { profile => $profile };
589 }
590
591 # FIXME - FRAGILE
592 # Hash::Merge is a sorry piece of shit and tramples all over $@
593 # *without* throwing an exception
594 # This is a rather serious problem in the debug codepath
595 # Insulate the condition here with a try{} until a review of
596 # DBIx::Class::Storage::Debug::PrettyPrint takes place
597 # we do rethrow the error unconditionally, the only reason
598 # to try{} is to preserve the precise state of $@ (down
599 # to the scalar (if there is one) address level)
600 #
601 # Yes I am aware this is fragile and TxnScopeGuard needs
602 # a better fix. This is another yak to shave... :(
603 try {
604 DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args);
605 } catch {
606 $self->throw_exception($_);
4d753fb8 607 }
608 }
609 else {
610 require DBIx::Class::Storage::Statistics;
611 DBIx::Class::Storage::Statistics->new
612 }
613 };
614}
615
046ad905 616=head2 debugcb
617
618Sets a callback to be executed each time a statement is run; takes a sub
619reference. Callback is executed as $sub->($op, $info) where $op is
620SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
621
f92a9d79 622See L</debugobj> for a better way.
046ad905 623
624=cut
625
626sub debugcb {
627 my $self = shift;
628
629 if ($self->debugobj->can('callback')) {
630 return $self->debugobj->callback(@_);
631 }
632}
633
e4eb8ee1 634=head2 cursor_class
046ad905 635
636The cursor class for this Storage object.
637
638=cut
639
046ad905 640=head2 deploy
641
642Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
643Storage class). This would normally be called through
644L<DBIx::Class::Schema/deploy>.
645
646=cut
647
648sub deploy { die "Virtual method!" }
649
a3eaff0e 650=head2 connect_info
651
652The arguments of C<connect_info> are always a single array reference,
653and are Storage-handler specific.
654
655This is normally accessed via L<DBIx::Class::Schema/connection>, which
656encapsulates its argument list in an arrayref before calling
657C<connect_info> here.
658
659=cut
660
046ad905 661sub connect_info { die "Virtual method!" }
a3eaff0e 662
663=head2 select
664
665Handle a select statement.
666
667=cut
668
669sub select { die "Virtual method!" }
670
671=head2 insert
672
673Handle an insert statement.
674
675=cut
676
046ad905 677sub insert { die "Virtual method!" }
a3eaff0e 678
679=head2 update
680
681Handle an update statement.
682
683=cut
684
046ad905 685sub update { die "Virtual method!" }
a3eaff0e 686
687=head2 delete
688
689Handle a delete statement.
690
691=cut
692
046ad905 693sub delete { die "Virtual method!" }
a3eaff0e 694
695=head2 select_single
696
697Performs a select, fetch and return of data - handles a single row
698only.
699
700=cut
701
046ad905 702sub select_single { die "Virtual method!" }
a3eaff0e 703
704=head2 columns_info_for
705
c22c7625 706Returns metadata for the given source's columns. This
707is *deprecated*, and will be removed before 1.0. You should
708be specifying the metadata yourself if you need it.
a3eaff0e 709
710=cut
711
046ad905 712sub columns_info_for { die "Virtual method!" }
713
714=head1 ENVIRONMENT VARIABLES
715
716=head2 DBIC_TRACE
717
718If C<DBIC_TRACE> is set then trace information
f92a9d79 719is produced (as when the L</debug> method is set).
046ad905 720
721If the value is of the form C<1=/path/name> then the trace output is
722written to the file C</path/name>.
723
724This environment variable is checked when the storage object is first
fd323bf1 725created (when you call connect on your schema). So, run-time changes
726to this environment variable will not take effect unless you also
046ad905 727re-connect on your schema.
728
b6cd6478 729=head2 DBIC_TRACE_PROFILE
730
2514a73f 731If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::Debug::PrettyPrint>
b6cd6478 732will be used to format the output from C<DBIC_TRACE>. The value it
733is set to is the C<profile> that it will be used. If the value is a
734filename the file is read with L<Config::Any> and the results are
735used as the configuration for tracing. See L<SQL::Abstract::Tree/new>
736for what that structure should look like.
737
046ad905 738=head2 DBIX_CLASS_STORAGE_DBI_DEBUG
739
740Old name for DBIC_TRACE
741
ace385bd 742=head1 SEE ALSO
743
2f0790c4 744L<DBIx::Class::Storage::DBI> - reference storage implementation using
745SQL::Abstract and DBI.
ace385bd 746
a2bd3796 747=head1 FURTHER QUESTIONS?
046ad905 748
a2bd3796 749Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
046ad905 750
a2bd3796 751=head1 COPYRIGHT AND LICENSE
046ad905 752
a2bd3796 753This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
754by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
755redistribute it and/or modify it under the same terms as the
756L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
046ad905 757
758=cut
759
a62cf8d4 7601;