Merge 'sybase' into 'trunk'
[dbsrgits/DBIx-Class-Historic.git] / 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 svp_begin
266
267 Arguments: $savepoint_name?
268
269 Created a new savepoint using the name provided as argument. If no name
270 is provided, a random name will be used.
271
272 =cut
273
274 sub svp_begin { die "Virtual method!" }
275
276 =head2 svp_release
277
278 Arguments: $savepoint_name?
279
280 Release the savepoint provided as argument. If none is provided,
281 release the savepoint created most recently. This will implicitly
282 release all savepoints created after the one explicitly released as well.
283
284 =cut
285
286 sub svp_release { die "Virtual method!" }
287
288 =head2 svp_rollback
289
290 Arguments: $savepoint_name?
291
292 Rollback to the savepoint provided as argument. If none is provided,
293 rollback to the savepoint created most recently. This will implicitly
294 release all savepoints created after the savepoint we rollback to.
295
296 =cut
297
298 sub svp_rollback { die "Virtual method!" }
299
300 =for comment
301
302 =head2 txn_scope_guard (EXPERIMENTAL)
303
304 An alternative way of using transactions to C<txn_do>:
305
306  my $txn = $storage->txn_scope_guard;
307
308  $row->col1("val1");
309  $row->update;
310
311  $txn->commit;
312
313 If a exception occurs, the transaction will be rolled back. This is still very
314 experiemental, and we are not 100% sure it is working right when nested. The
315 onus is on you as the user to make sure you dont forget to call
316 $C<$txn->commit>.
317
318 =cut
319
320 sub txn_scope_guard {
321   return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
322 }
323
324 =head2 sql_maker
325
326 Returns a C<sql_maker> object - normally an object of class
327 C<DBIC::SQL::Abstract>.
328
329 =cut
330
331 sub sql_maker { die "Virtual method!" }
332
333 =head2 debug
334
335 Causes trace information to be emitted on the C<debugobj> object.
336 (or C<STDERR> if C<debugobj> has not specifically been set).
337
338 This is the equivalent to setting L</DBIC_TRACE> in your
339 shell environment.
340
341 =head2 debugfh
342
343 Set or retrieve the filehandle used for trace/debug output.  This should be
344 an IO::Handle compatible ojbect (only the C<print> method is used.  Initially
345 set to be STDERR - although see information on the
346 L<DBIC_TRACE> environment variable.
347
348 =cut
349
350 sub debugfh {
351     my $self = shift;
352
353     if ($self->debugobj->can('debugfh')) {
354         return $self->debugobj->debugfh(@_);
355     }
356 }
357
358 =head2 debugobj
359
360 Sets or retrieves the object used for metric collection. Defaults to an instance
361 of L<DBIx::Class::Storage::Statistics> that is compatible with the original
362 method of using a coderef as a callback.  See the aforementioned Statistics
363 class for more information.
364
365 =head2 debugcb
366
367 Sets a callback to be executed each time a statement is run; takes a sub
368 reference.  Callback is executed as $sub->($op, $info) where $op is
369 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
370
371 See L<debugobj> for a better way.
372
373 =cut
374
375 sub debugcb {
376     my $self = shift;
377
378     if ($self->debugobj->can('callback')) {
379         return $self->debugobj->callback(@_);
380     }
381 }
382
383 =head2 cursor_class
384
385 The cursor class for this Storage object.
386
387 =cut
388
389 =head2 deploy
390
391 Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
392 Storage class). This would normally be called through
393 L<DBIx::Class::Schema/deploy>.
394
395 =cut
396
397 sub deploy { die "Virtual method!" }
398
399 =head2 connect_info
400
401 The arguments of C<connect_info> are always a single array reference,
402 and are Storage-handler specific.
403
404 This is normally accessed via L<DBIx::Class::Schema/connection>, which
405 encapsulates its argument list in an arrayref before calling
406 C<connect_info> here.
407
408 =cut
409
410 sub connect_info { die "Virtual method!" }
411
412 =head2 select
413
414 Handle a select statement.
415
416 =cut
417
418 sub select { die "Virtual method!" }
419
420 =head2 insert
421
422 Handle an insert statement.
423
424 =cut
425
426 sub insert { die "Virtual method!" }
427
428 =head2 update
429
430 Handle an update statement.
431
432 =cut
433
434 sub update { die "Virtual method!" }
435
436 =head2 delete
437
438 Handle a delete statement.
439
440 =cut
441
442 sub delete { die "Virtual method!" }
443
444 =head2 select_single
445
446 Performs a select, fetch and return of data - handles a single row
447 only.
448
449 =cut
450
451 sub select_single { die "Virtual method!" }
452
453 =head2 columns_info_for
454
455 Returns metadata for the given source's columns.  This
456 is *deprecated*, and will be removed before 1.0.  You should
457 be specifying the metadata yourself if you need it.
458
459 =cut
460
461 sub columns_info_for { die "Virtual method!" }
462
463 =head1 ENVIRONMENT VARIABLES
464
465 =head2 DBIC_TRACE
466
467 If C<DBIC_TRACE> is set then trace information
468 is produced (as when the L<debug> method is set).
469
470 If the value is of the form C<1=/path/name> then the trace output is
471 written to the file C</path/name>.
472
473 This environment variable is checked when the storage object is first
474 created (when you call connect on your schema).  So, run-time changes 
475 to this environment variable will not take effect unless you also 
476 re-connect on your schema.
477
478 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
479
480 Old name for DBIC_TRACE
481
482 =head1 SEE ALSO
483
484 L<DBIx::Class::Storage::DBI> - reference storage implementation using
485 SQL::Abstract and DBI.
486
487 =head1 AUTHORS
488
489 Matt S. Trout <mst@shadowcatsystems.co.uk>
490
491 Andy Grundman <andy@hybridized.org>
492
493 =head1 LICENSE
494
495 You may distribute this code under the same terms as Perl itself.
496
497 =cut
498
499 1;