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