lib/DBIx/Class/Storage.pm

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