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
   8 use Scalar::Util qw/weaken/;
   9 use Carp::Clan qw/^DBIx::Class/;
  10 use IO::File;
  11 use DBIx::Class::Storage::TxnScopeGuard;
  12
  13 __PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/);
  14 __PACKAGE__->mk_group_accessors('inherited' => 'cursor_class');
  15
  16 __PACKAGE__->cursor_class('DBIx::Class::Cursor');
  17
  18 sub cursor { shift->cursor_class(@_); }
  19
  20 package # Hide from PAUSE
  21     DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
  22
  23 use overload '"' => sub {
  24   'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION'
  25 };
  26
  27 sub new {
  28   my $class = shift;
  29   my $self = {};
  30   return bless $self, $class;
  31 }
  32
  33 package DBIx::Class::Storage;
  34
  35 =head1 NAME
  36
  37 DBIx::Class::Storage - Generic Storage Handler
  38
  39 =head1 DESCRIPTION
  40
  41 A base implementation of common Storage methods.  For specific
  42 information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.
  43
  44 =head1 METHODS
  45
  46 =head2 new
  47
  48 Arguments: $schema
  49
  50 Instantiates the Storage object.
  51
  52 =cut
  53
  54 sub new {
  55   my ($self, $schema) = @_;
  56
  57   $self = ref $self if ref $self;
  58
  59   my $new = {};
  60   bless $new, $self;
  61
  62   $new->set_schema($schema);
  63   $new->debugobj(new DBIx::Class::Storage::Statistics());
  64
  65   #my $fh;
  66
  67   my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
  68                   || $ENV{DBIC_TRACE};
  69
  70   $new->debug(1) if $debug_env;
  71
  72   $new;
  73 }
  74
  75 =head2 set_schema
  76
  77 Used to reset the schema class or object which owns this
  78 storage object, such as during L<DBIx::Class::Schema/clone>.
  79
  80 =cut
  81
  82 sub set_schema {
  83   my ($self, $schema) = @_;
  84   $self->schema($schema);
  85   weaken($self->{schema}) if ref $self->{schema};
  86 }
  87
  88 =head2 connected
  89
  90 Returns true if we have an open storage connection, false
  91 if it is not (yet) open.
  92
  93 =cut
  94
  95 sub connected { die "Virtual method!" }
  96
  97 =head2 disconnect
  98
  99 Closes any open storage connection unconditionally.
 100
 101 =cut
 102
 103 sub disconnect { die "Virtual method!" }
 104
 105 =head2 ensure_connected
 106
 107 Initiate a connection to the storage if one isn't already open.
 108
 109 =cut
 110
 111 sub ensure_connected { die "Virtual method!" }
 112
 113 =head2 throw_exception
 114
 115 Throws an exception - croaks.
 116
 117 =cut
 118
 119 sub throw_exception {
 120   my $self = shift;
 121
 122   $self->schema->throw_exception(@_) if $self->schema;
 123   croak @_;
 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   eval {
 157     $rs = $schema->txn_do($coderef);
 158   };
 159
 160   if ($@) {                                  # Transaction failed
 161     die "something terrible has happened!"   #
 162       if ($@ =~ /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, $coderef, @args) = @_;
 184
 185   ref $coderef eq 'CODE' or $self->throw_exception
 186     ('$coderef must be a CODE reference');
 187
 188   my (@return_values, $return_value);
 189
 190   $self->txn_begin; # If this throws an exception, no rollback is needed
 191
 192   my $wantarray = wantarray; # Need to save this since the context
 193                              # inside the eval{} block is independent
 194                              # of the context that called txn_do()
 195   eval {
 196
 197     # Need to differentiate between scalar/list context to allow for
 198     # returning a list in scalar context to get the size of the list
 199     if ($wantarray) {
 200       # list context
 201       @return_values = $coderef->(@args);
 202     } elsif (defined $wantarray) {
 203       # scalar context
 204       $return_value = $coderef->(@args);
 205     } else {
 206       # void context
 207       $coderef->(@args);
 208     }
 209     $self->txn_commit;
 210   };
 211
 212   if ($@) {
 213     my $error = $@;
 214
 215     eval {
 216       $self->txn_rollback;
 217     };
 218
 219     if ($@) {
 220       my $rollback_error = $@;
 221       my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
 222       $self->throw_exception($error)  # propagate nested rollback
 223         if $rollback_error =~ /$exception_class/;
 224
 225       $self->throw_exception(
 226         "Transaction aborted: $error. Rollback failed: ${rollback_error}"
 227       );
 228     } else {
 229       $self->throw_exception($error); # txn failed but rollback succeeded
 230     }
 231   }
 232
 233   return $wantarray ? @return_values : $return_value;
 234 }
 235
 236 =head2 txn_begin
 237
 238 Starts a transaction.
 239
 240 See the preferred L</txn_do> method, which allows for
 241 an entire code block to be executed transactionally.
 242
 243 =cut
 244
 245 sub txn_begin { die "Virtual method!" }
 246
 247 =head2 txn_commit
 248
 249 Issues a commit of the current transaction.
 250
 251 =cut
 252
 253 sub txn_commit { die "Virtual method!" }
 254
 255 =head2 txn_rollback
 256
 257 Issues a rollback of the current transaction. A nested rollback will
 258 throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
 259 which allows the rollback to propagate to the outermost transaction.
 260
 261 =cut
 262
 263 sub txn_rollback { die "Virtual method!" }
 264
 265 =for
 266
 267 =head2 txn_scope_guard
 268
 269 Return an object that does stuff.
 270
 271 =cut
 272
 273 sub txn_scope_guard {
 274   return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
 275 }
 276
 277 =head2 sql_maker
 278
 279 Returns a C<sql_maker> object - normally an object of class
 280 C<DBIC::SQL::Abstract>.
 281
 282 =cut
 283
 284 sub sql_maker { die "Virtual method!" }
 285
 286 =head2 debug
 287
 288 Causes trace information to be emitted on the C<debugobj> object.
 289 (or C<STDERR> if C<debugobj> has not specifically been set).
 290
 291 This is the equivalent to setting L</DBIC_TRACE> in your
 292 shell environment.
 293
 294 =head2 debugfh
 295
 296 Set or retrieve the filehandle used for trace/debug output.  This should be
 297 an IO::Handle compatible ojbect (only the C<print> method is used.  Initially
 298 set to be STDERR - although see information on the
 299 L<DBIC_TRACE> environment variable.
 300
 301 =cut
 302
 303 sub debugfh {
 304     my $self = shift;
 305
 306     if ($self->debugobj->can('debugfh')) {
 307         return $self->debugobj->debugfh(@_);
 308     }
 309 }
 310
 311 =head2 debugobj
 312
 313 Sets or retrieves the object used for metric collection. Defaults to an instance
 314 of L<DBIx::Class::Storage::Statistics> that is compatible with the original
 315 method of using a coderef as a callback.  See the aforementioned Statistics
 316 class for more information.
 317
 318 =head2 debugcb
 319
 320 Sets a callback to be executed each time a statement is run; takes a sub
 321 reference.  Callback is executed as $sub->($op, $info) where $op is
 322 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
 323
 324 See L<debugobj> for a better way.
 325
 326 =cut
 327
 328 sub debugcb {
 329     my $self = shift;
 330
 331     if ($self->debugobj->can('callback')) {
 332         return $self->debugobj->callback(@_);
 333     }
 334 }
 335
 336 =head2 cursor_class
 337
 338 The cursor class for this Storage object.
 339
 340 =cut
 341
 342 =head2 deploy
 343
 344 Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
 345 Storage class). This would normally be called through
 346 L<DBIx::Class::Schema/deploy>.
 347
 348 =cut
 349
 350 sub deploy { die "Virtual method!" }
 351
 352 =head2 connect_info
 353
 354 The arguments of C<connect_info> are always a single array reference,
 355 and are Storage-handler specific.
 356
 357 This is normally accessed via L<DBIx::Class::Schema/connection>, which
 358 encapsulates its argument list in an arrayref before calling
 359 C<connect_info> here.
 360
 361 =cut
 362
 363 sub connect_info { die "Virtual method!" }
 364
 365 =head2 select
 366
 367 Handle a select statement.
 368
 369 =cut
 370
 371 sub select { die "Virtual method!" }
 372
 373 =head2 insert
 374
 375 Handle an insert statement.
 376
 377 =cut
 378
 379 sub insert { die "Virtual method!" }
 380
 381 =head2 update
 382
 383 Handle an update statement.
 384
 385 =cut
 386
 387 sub update { die "Virtual method!" }
 388
 389 =head2 delete
 390
 391 Handle a delete statement.
 392
 393 =cut
 394
 395 sub delete { die "Virtual method!" }
 396
 397 =head2 select_single
 398
 399 Performs a select, fetch and return of data - handles a single row
 400 only.
 401
 402 =cut
 403
 404 sub select_single { die "Virtual method!" }
 405
 406 =head2 columns_info_for
 407
 408 Returns metadata for the given source's columns.  This
 409 is *deprecated*, and will be removed before 1.0.  You should
 410 be specifying the metadata yourself if you need it.
 411
 412 =cut
 413
 414 sub columns_info_for { die "Virtual method!" }
 415
 416 =head1 ENVIRONMENT VARIABLES
 417
 418 =head2 DBIC_TRACE
 419
 420 If C<DBIC_TRACE> is set then trace information
 421 is produced (as when the L<debug> method is set).
 422
 423 If the value is of the form C<1=/path/name> then the trace output is
 424 written to the file C</path/name>.
 425
 426 This environment variable is checked when the storage object is first
 427 created (when you call connect on your schema).  So, run-time changes
 428 to this environment variable will not take effect unless you also
 429 re-connect on your schema.
 430
 431 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
 432
 433 Old name for DBIC_TRACE
 434
 435 =head1 SEE ALSO
 436
 437 L<DBIx::Class::Storage::DBI> - reference storage inplementation using SQL::Abstract and DBI.
 438
 439 =head1 AUTHORS
 440
 441 Matt S. Trout <mst@shadowcatsystems.co.uk>
 442
 443 Andy Grundman <andy@hybridized.org>
 444
 445 =head1 LICENSE
 446
 447 You may distribute this code under the same terms as Perl itself.
 448
 449 =cut
 450
 451 1;