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 =head2 txn_scope_guard
 266
 267 Return an object that does stuff.
 268
 269 =cut
 270
 271 sub txn_scope_guard {
 272   return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
 273 }
 274
 275 =head2 sql_maker
 276
 277 Returns a C<sql_maker> object - normally an object of class
 278 C<DBIC::SQL::Abstract>.
 279
 280 =cut
 281
 282 sub sql_maker { die "Virtual method!" }
 283
 284 =head2 debug
 285
 286 Causes trace information to be emitted on the C<debugobj> object.
 287 (or C<STDERR> if C<debugobj> has not specifically been set).
 288
 289 This is the equivalent to setting L</DBIC_TRACE> in your
 290 shell environment.
 291
 292 =head2 debugfh
 293
 294 Set or retrieve the filehandle used for trace/debug output.  This should be
 295 an IO::Handle compatible ojbect (only the C<print> method is used.  Initially
 296 set to be STDERR - although see information on the
 297 L<DBIC_TRACE> environment variable.
 298
 299 =cut
 300
 301 sub debugfh {
 302     my $self = shift;
 303
 304     if ($self->debugobj->can('debugfh')) {
 305         return $self->debugobj->debugfh(@_);
 306     }
 307 }
 308
 309 =head2 debugobj
 310
 311 Sets or retrieves the object used for metric collection. Defaults to an instance
 312 of L<DBIx::Class::Storage::Statistics> that is compatible with the original
 313 method of using a coderef as a callback.  See the aforementioned Statistics
 314 class for more information.
 315
 316 =head2 debugcb
 317
 318 Sets a callback to be executed each time a statement is run; takes a sub
 319 reference.  Callback is executed as $sub->($op, $info) where $op is
 320 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
 321
 322 See L<debugobj> for a better way.
 323
 324 =cut
 325
 326 sub debugcb {
 327     my $self = shift;
 328
 329     if ($self->debugobj->can('callback')) {
 330         return $self->debugobj->callback(@_);
 331     }
 332 }
 333
 334 =head2 cursor_class
 335
 336 The cursor class for this Storage object.
 337
 338 =cut
 339
 340 =head2 deploy
 341
 342 Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
 343 Storage class). This would normally be called through
 344 L<DBIx::Class::Schema/deploy>.
 345
 346 =cut
 347
 348 sub deploy { die "Virtual method!" }
 349
 350 =head2 connect_info
 351
 352 The arguments of C<connect_info> are always a single array reference,
 353 and are Storage-handler specific.
 354
 355 This is normally accessed via L<DBIx::Class::Schema/connection>, which
 356 encapsulates its argument list in an arrayref before calling
 357 C<connect_info> here.
 358
 359 =cut
 360
 361 sub connect_info { die "Virtual method!" }
 362
 363 =head2 select
 364
 365 Handle a select statement.
 366
 367 =cut
 368
 369 sub select { die "Virtual method!" }
 370
 371 =head2 insert
 372
 373 Handle an insert statement.
 374
 375 =cut
 376
 377 sub insert { die "Virtual method!" }
 378
 379 =head2 update
 380
 381 Handle an update statement.
 382
 383 =cut
 384
 385 sub update { die "Virtual method!" }
 386
 387 =head2 delete
 388
 389 Handle a delete statement.
 390
 391 =cut
 392
 393 sub delete { die "Virtual method!" }
 394
 395 =head2 select_single
 396
 397 Performs a select, fetch and return of data - handles a single row
 398 only.
 399
 400 =cut
 401
 402 sub select_single { die "Virtual method!" }
 403
 404 =head2 columns_info_for
 405
 406 Returns metadata for the given source's columns.  This
 407 is *deprecated*, and will be removed before 1.0.  You should
 408 be specifying the metadata yourself if you need it.
 409
 410 =cut
 411
 412 sub columns_info_for { die "Virtual method!" }
 413
 414 =head1 ENVIRONMENT VARIABLES
 415
 416 =head2 DBIC_TRACE
 417
 418 If C<DBIC_TRACE> is set then trace information
 419 is produced (as when the L<debug> method is set).
 420
 421 If the value is of the form C<1=/path/name> then the trace output is
 422 written to the file C</path/name>.
 423
 424 This environment variable is checked when the storage object is first
 425 created (when you call connect on your schema).  So, run-time changes
 426 to this environment variable will not take effect unless you also
 427 re-connect on your schema.
 428
 429 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
 430
 431 Old name for DBIC_TRACE
 432
 433 =head1 SEE ALSO
 434
 435 L<DBIx::Class::Storage::DBI> - reference storage inplementation using SQL::Abstract and DBI.
 436
 437 =head1 AUTHORS
 438
 439 Matt S. Trout <mst@shadowcatsystems.co.uk>
 440
 441 Andy Grundman <andy@hybridized.org>
 442
 443 =head1 LICENSE
 444
 445 You may distribute this code under the same terms as Perl itself.
 446
 447 =cut
 448
 449 1;