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