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 use DBIx::Class::Exception;
  10 use Scalar::Util 'weaken';
  11 use IO::File;
  12 use DBIx::Class::Storage::TxnScopeGuard;
  13 use Try::Tiny;
  14 use namespace::clean;
  15
  16 __PACKAGE__->mk_group_accessors('simple' => qw/debug schema/);
  17 __PACKAGE__->mk_group_accessors('inherited' => 'cursor_class');
  18
  19 __PACKAGE__->cursor_class('DBIx::Class::Cursor');
  20
  21 sub cursor { shift->cursor_class(@_); }
  22
  23 package # Hide from PAUSE
  24     DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
  25
  26 use overload '"' => sub {
  27   'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION'
  28 };
  29
  30 sub new {
  31   my $class = shift;
  32   my $self = {};
  33   return bless $self, $class;
  34 }
  35
  36 package DBIx::Class::Storage;
  37
  38 =head1 NAME
  39
  40 DBIx::Class::Storage - Generic Storage Handler
  41
  42 =head1 DESCRIPTION
  43
  44 A base implementation of common Storage methods.  For specific
  45 information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.
  46
  47 =head1 METHODS
  48
  49 =head2 new
  50
  51 Arguments: $schema
  52
  53 Instantiates the Storage object.
  54
  55 =cut
  56
  57 sub new {
  58   my ($self, $schema) = @_;
  59
  60   $self = ref $self if ref $self;
  61
  62   my $new = {};
  63   bless $new, $self;
  64
  65   $new->set_schema($schema);
  66   $new->debug(1)
  67     if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
  68
  69   $new;
  70 }
  71
  72 =head2 set_schema
  73
  74 Used to reset the schema class or object which owns this
  75 storage object, such as during L<DBIx::Class::Schema/clone>.
  76
  77 =cut
  78
  79 sub set_schema {
  80   my ($self, $schema) = @_;
  81   $self->schema($schema);
  82   weaken $self->{schema} if ref $self->{schema};
  83 }
  84
  85 =head2 connected
  86
  87 Returns true if we have an open storage connection, false
  88 if it is not (yet) open.
  89
  90 =cut
  91
  92 sub connected { die "Virtual method!" }
  93
  94 =head2 disconnect
  95
  96 Closes any open storage connection unconditionally.
  97
  98 =cut
  99
 100 sub disconnect { die "Virtual method!" }
 101
 102 =head2 ensure_connected
 103
 104 Initiate a connection to the storage if one isn't already open.
 105
 106 =cut
 107
 108 sub ensure_connected { die "Virtual method!" }
 109
 110 =head2 throw_exception
 111
 112 Throws an exception - croaks.
 113
 114 =cut
 115
 116 sub throw_exception {
 117   my $self = shift;
 118
 119   if (ref $self and $self->schema) {
 120     $self->schema->throw_exception(@_);
 121   }
 122   else {
 123     DBIx::Class::Exception->throw(@_);
 124   }
 125 }
 126
 127 =head2 txn_do
 128
 129 =over 4
 130
 131 =item Arguments: C<$coderef>, @coderef_args?
 132
 133 =item Return Value: The return value of $coderef
 134
 135 =back
 136
 137 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
 138 returning its result (if any). If an exception is caught, a rollback is issued
 139 and the exception is rethrown. If the rollback fails, (i.e. throws an
 140 exception) an exception is thrown that includes a "Rollback failed" message.
 141
 142 For example,
 143
 144   my $author_rs = $schema->resultset('Author')->find(1);
 145   my @titles = qw/Night Day It/;
 146
 147   my $coderef = sub {
 148     # If any one of these fails, the entire transaction fails
 149     $author_rs->create_related('books', {
 150       title => $_
 151     }) foreach (@titles);
 152
 153     return $author->books;
 154   };
 155
 156   my $rs;
 157   try {
 158     $rs = $schema->txn_do($coderef);
 159   } catch {
 160     my $error = shift;
 161     # Transaction failed
 162     die "something terrible has happened!"   #
 163       if ($error =~ /Rollback failed/);          # Rollback failed
 164
 165     deal_with_failed_transaction();
 166   };
 167
 168 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
 169 the outermost transaction will issue a L</txn_commit>, and txn_do() can be
 170 called in void, scalar and list context and it will behave as expected.
 171
 172 Please note that all of the code in your coderef, including non-DBIx::Class
 173 code, is part of a transaction.  This transaction may fail out halfway, or
 174 it may get partially double-executed (in the case that our DB connection
 175 failed halfway through the transaction, in which case we reconnect and
 176 restart the txn).  Therefore it is best that any side-effects in your coderef
 177 are idempotent (that is, can be re-executed multiple times and get the
 178 same result), and that you check up on your side-effects in the case of
 179 transaction failure.
 180
 181 =cut
 182
 183 sub txn_do {
 184   my $self = shift;
 185   my $coderef = shift;
 186
 187   ref $coderef eq 'CODE' or $self->throw_exception
 188     ('$coderef must be a CODE reference');
 189
 190   my (@return_values, $return_value);
 191
 192   $self->txn_begin; # If this throws an exception, no rollback is needed
 193
 194   my $wantarray = wantarray; # Need to save this since the context
 195                              # inside the try{} block is independent
 196                              # of the context that called txn_do()
 197   my $args = \@_;
 198
 199   try {
 200
 201     # Need to differentiate between scalar/list context to allow for
 202     # returning a list in scalar context to get the size of the list
 203     if ($wantarray) {
 204       # list context
 205       @return_values = $coderef->(@$args);
 206     } elsif (defined $wantarray) {
 207       # scalar context
 208       $return_value = $coderef->(@$args);
 209     } else {
 210       # void context
 211       $coderef->(@$args);
 212     }
 213     $self->txn_commit;
 214   }
 215   catch {
 216     my $error = shift;
 217
 218     try {
 219       $self->txn_rollback;
 220     } catch {
 221       my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
 222       $self->throw_exception($error)  # propagate nested rollback
 223         if $_ =~ /$exception_class/;
 224
 225       $self->throw_exception(
 226         "Transaction aborted: $error. Rollback failed: $_"
 227       );
 228     }
 229     $self->throw_exception($error); # txn failed but rollback succeeded
 230   };
 231
 232   return wantarray ? @return_values : $return_value;
 233 }
 234
 235 =head2 txn_begin
 236
 237 Starts a transaction.
 238
 239 See the preferred L</txn_do> method, which allows for
 240 an entire code block to be executed transactionally.
 241
 242 =cut
 243
 244 sub txn_begin { die "Virtual method!" }
 245
 246 =head2 txn_commit
 247
 248 Issues a commit of the current transaction.
 249
 250 It does I<not> perform an actual storage commit unless there's a DBIx::Class
 251 transaction currently in effect (i.e. you called L</txn_begin>).
 252
 253 =cut
 254
 255 sub txn_commit { die "Virtual method!" }
 256
 257 =head2 txn_rollback
 258
 259 Issues a rollback of the current transaction. A nested rollback will
 260 throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
 261 which allows the rollback to propagate to the outermost transaction.
 262
 263 =cut
 264
 265 sub txn_rollback { die "Virtual method!" }
 266
 267 =head2 svp_begin
 268
 269 Arguments: $savepoint_name?
 270
 271 Created a new savepoint using the name provided as argument. If no name
 272 is provided, a random name will be used.
 273
 274 =cut
 275
 276 sub svp_begin { die "Virtual method!" }
 277
 278 =head2 svp_release
 279
 280 Arguments: $savepoint_name?
 281
 282 Release the savepoint provided as argument. If none is provided,
 283 release the savepoint created most recently. This will implicitly
 284 release all savepoints created after the one explicitly released as well.
 285
 286 =cut
 287
 288 sub svp_release { die "Virtual method!" }
 289
 290 =head2 svp_rollback
 291
 292 Arguments: $savepoint_name?
 293
 294 Rollback to the savepoint provided as argument. If none is provided,
 295 rollback to the savepoint created most recently. This will implicitly
 296 release all savepoints created after the savepoint we rollback to.
 297
 298 =cut
 299
 300 sub svp_rollback { die "Virtual method!" }
 301
 302 =for comment
 303
 304 =head2 txn_scope_guard
 305
 306 An alternative way of transaction handling based on
 307 L<DBIx::Class::Storage::TxnScopeGuard>:
 308
 309  my $txn_guard = $storage->txn_scope_guard;
 310
 311  $row->col1("val1");
 312  $row->update;
 313
 314  $txn_guard->commit;
 315
 316 If an exception occurs, or the guard object otherwise leaves the scope
 317 before C<< $txn_guard->commit >> is called, the transaction will be rolled
 318 back by an explicit L</txn_rollback> call. In essence this is akin to
 319 using a L</txn_begin>/L</txn_commit> pair, without having to worry
 320 about calling L</txn_rollback> at the right places. Note that since there
 321 is no defined code closure, there will be no retries and other magic upon
 322 database disconnection. If you need such functionality see L</txn_do>.
 323
 324 =cut
 325
 326 sub txn_scope_guard {
 327   return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
 328 }
 329
 330 =head2 sql_maker
 331
 332 Returns a C<sql_maker> object - normally an object of class
 333 C<DBIx::Class::SQLMaker>.
 334
 335 =cut
 336
 337 sub sql_maker { die "Virtual method!" }
 338
 339 =head2 debug
 340
 341 Causes trace information to be emitted on the C<debugobj> object.
 342 (or C<STDERR> if C<debugobj> has not specifically been set).
 343
 344 This is the equivalent to setting L</DBIC_TRACE> in your
 345 shell environment.
 346
 347 =head2 debugfh
 348
 349 Set or retrieve the filehandle used for trace/debug output.  This should be
 350 an IO::Handle compatible object (only the C<print> method is used.  Initially
 351 set to be STDERR - although see information on the
 352 L<DBIC_TRACE> environment variable.
 353
 354 =cut
 355
 356 sub debugfh {
 357     my $self = shift;
 358
 359     if ($self->debugobj->can('debugfh')) {
 360         return $self->debugobj->debugfh(@_);
 361     }
 362 }
 363
 364 =head2 debugobj
 365
 366 Sets or retrieves the object used for metric collection. Defaults to an instance
 367 of L<DBIx::Class::Storage::Statistics> that is compatible with the original
 368 method of using a coderef as a callback.  See the aforementioned Statistics
 369 class for more information.
 370
 371 =cut
 372
 373 sub debugobj {
 374   my $self = shift;
 375
 376   if (@_) {
 377     return $self->{debugobj} = $_[0];
 378   }
 379
 380   $self->{debugobj} ||= do {
 381     if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
 382       require DBIx::Class::Storage::Debug::PrettyPrint;
 383       if ($profile =~ /^\.?\//) {
 384         require Config::Any;
 385
 386         my $cfg = try {
 387           Config::Any->load_files({ files => [$profile], use_ext => 1 });
 388         } catch {
 389           # sanitize the error message a bit
 390           $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x;
 391           $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_");
 392         };
 393
 394         DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]});
 395       }
 396       else {
 397         DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile });
 398       }
 399     }
 400     else {
 401       require DBIx::Class::Storage::Statistics;
 402       DBIx::Class::Storage::Statistics->new
 403     }
 404   };
 405 }
 406
 407 =head2 debugcb
 408
 409 Sets a callback to be executed each time a statement is run; takes a sub
 410 reference.  Callback is executed as $sub->($op, $info) where $op is
 411 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
 412
 413 See L<debugobj> for a better way.
 414
 415 =cut
 416
 417 sub debugcb {
 418     my $self = shift;
 419
 420     if ($self->debugobj->can('callback')) {
 421         return $self->debugobj->callback(@_);
 422     }
 423 }
 424
 425 =head2 cursor_class
 426
 427 The cursor class for this Storage object.
 428
 429 =cut
 430
 431 =head2 deploy
 432
 433 Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
 434 Storage class). This would normally be called through
 435 L<DBIx::Class::Schema/deploy>.
 436
 437 =cut
 438
 439 sub deploy { die "Virtual method!" }
 440
 441 =head2 connect_info
 442
 443 The arguments of C<connect_info> are always a single array reference,
 444 and are Storage-handler specific.
 445
 446 This is normally accessed via L<DBIx::Class::Schema/connection>, which
 447 encapsulates its argument list in an arrayref before calling
 448 C<connect_info> here.
 449
 450 =cut
 451
 452 sub connect_info { die "Virtual method!" }
 453
 454 =head2 select
 455
 456 Handle a select statement.
 457
 458 =cut
 459
 460 sub select { die "Virtual method!" }
 461
 462 =head2 insert
 463
 464 Handle an insert statement.
 465
 466 =cut
 467
 468 sub insert { die "Virtual method!" }
 469
 470 =head2 update
 471
 472 Handle an update statement.
 473
 474 =cut
 475
 476 sub update { die "Virtual method!" }
 477
 478 =head2 delete
 479
 480 Handle a delete statement.
 481
 482 =cut
 483
 484 sub delete { die "Virtual method!" }
 485
 486 =head2 select_single
 487
 488 Performs a select, fetch and return of data - handles a single row
 489 only.
 490
 491 =cut
 492
 493 sub select_single { die "Virtual method!" }
 494
 495 =head2 columns_info_for
 496
 497 Returns metadata for the given source's columns.  This
 498 is *deprecated*, and will be removed before 1.0.  You should
 499 be specifying the metadata yourself if you need it.
 500
 501 =cut
 502
 503 sub columns_info_for { die "Virtual method!" }
 504
 505 =head1 ENVIRONMENT VARIABLES
 506
 507 =head2 DBIC_TRACE
 508
 509 If C<DBIC_TRACE> is set then trace information
 510 is produced (as when the L<debug> method is set).
 511
 512 If the value is of the form C<1=/path/name> then the trace output is
 513 written to the file C</path/name>.
 514
 515 This environment variable is checked when the storage object is first
 516 created (when you call connect on your schema).  So, run-time changes
 517 to this environment variable will not take effect unless you also
 518 re-connect on your schema.
 519
 520 =head2 DBIC_TRACE_PROFILE
 521
 522 If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::PrettyPrint>
 523 will be used to format the output from C<DBIC_TRACE>.  The value it
 524 is set to is the C<profile> that it will be used.  If the value is a
 525 filename the file is read with L<Config::Any> and the results are
 526 used as the configuration for tracing.  See L<SQL::Abstract::Tree/new>
 527 for what that structure should look like.
 528
 529
 530 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
 531
 532 Old name for DBIC_TRACE
 533
 534 =head1 SEE ALSO
 535
 536 L<DBIx::Class::Storage::DBI> - reference storage implementation using
 537 SQL::Abstract and DBI.
 538
 539 =head1 AUTHORS
 540
 541 Matt S. Trout <mst@shadowcatsystems.co.uk>
 542
 543 Andy Grundman <andy@hybridized.org>
 544
 545 =head1 LICENSE
 546
 547 You may distribute this code under the same terms as Perl itself.
 548
 549 =cut
 550
 551 1;