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