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