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