1) changed all 4 space indentation to 2 space style indents for replication code...
[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
303
304 Return an object that does stuff.
305
306 =cut
307
308 sub txn_scope_guard {
309   return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
310 }
311
312 =head2 sql_maker
313
314 Returns a C<sql_maker> object - normally an object of class
315 C<DBIC::SQL::Abstract>.
316
317 =cut
318
319 sub sql_maker { die "Virtual method!" }
320
321 =head2 debug
322
323 Causes trace information to be emitted on the C<debugobj> object.
324 (or C<STDERR> if C<debugobj> has not specifically been set).
325
326 This is the equivalent to setting L</DBIC_TRACE> in your
327 shell environment.
328
329 =head2 debugfh
330
331 Set or retrieve the filehandle used for trace/debug output.  This should be
332 an IO::Handle compatible ojbect (only the C<print> method is used.  Initially
333 set to be STDERR - although see information on the
334 L<DBIC_TRACE> environment variable.
335
336 =cut
337
338 sub debugfh {
339     my $self = shift;
340
341     if ($self->debugobj->can('debugfh')) {
342         return $self->debugobj->debugfh(@_);
343     }
344 }
345
346 =head2 debugobj
347
348 Sets or retrieves the object used for metric collection. Defaults to an instance
349 of L<DBIx::Class::Storage::Statistics> that is compatible with the original
350 method of using a coderef as a callback.  See the aforementioned Statistics
351 class for more information.
352
353 =head2 debugcb
354
355 Sets a callback to be executed each time a statement is run; takes a sub
356 reference.  Callback is executed as $sub->($op, $info) where $op is
357 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
358
359 See L<debugobj> for a better way.
360
361 =cut
362
363 sub debugcb {
364     my $self = shift;
365
366     if ($self->debugobj->can('callback')) {
367         return $self->debugobj->callback(@_);
368     }
369 }
370
371 =head2 cursor_class
372
373 The cursor class for this Storage object.
374
375 =cut
376
377 =head2 deploy
378
379 Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
380 Storage class). This would normally be called through
381 L<DBIx::Class::Schema/deploy>.
382
383 =cut
384
385 sub deploy { die "Virtual method!" }
386
387 =head2 connect_info
388
389 The arguments of C<connect_info> are always a single array reference,
390 and are Storage-handler specific.
391
392 This is normally accessed via L<DBIx::Class::Schema/connection>, which
393 encapsulates its argument list in an arrayref before calling
394 C<connect_info> here.
395
396 =cut
397
398 sub connect_info { die "Virtual method!" }
399
400 =head2 select
401
402 Handle a select statement.
403
404 =cut
405
406 sub select { die "Virtual method!" }
407
408 =head2 insert
409
410 Handle an insert statement.
411
412 =cut
413
414 sub insert { die "Virtual method!" }
415
416 =head2 update
417
418 Handle an update statement.
419
420 =cut
421
422 sub update { die "Virtual method!" }
423
424 =head2 delete
425
426 Handle a delete statement.
427
428 =cut
429
430 sub delete { die "Virtual method!" }
431
432 =head2 select_single
433
434 Performs a select, fetch and return of data - handles a single row
435 only.
436
437 =cut
438
439 sub select_single { die "Virtual method!" }
440
441 =head2 reload_row ($row)
442
443 given a L<DBIx::Class::Row> object, loads and returns the matching version from
444 storage.  Does not effect the existing row object.
445
446 =cut
447
448 sub reload_row { die "Virtual method!" }
449
450 =head2 columns_info_for
451
452 Returns metadata for the given source's columns.  This
453 is *deprecated*, and will be removed before 1.0.  You should
454 be specifying the metadata yourself if you need it.
455
456 =cut
457
458 sub columns_info_for { die "Virtual method!" }
459
460 =head1 ENVIRONMENT VARIABLES
461
462 =head2 DBIC_TRACE
463
464 If C<DBIC_TRACE> is set then trace information
465 is produced (as when the L<debug> method is set).
466
467 If the value is of the form C<1=/path/name> then the trace output is
468 written to the file C</path/name>.
469
470 This environment variable is checked when the storage object is first
471 created (when you call connect on your schema).  So, run-time changes 
472 to this environment variable will not take effect unless you also 
473 re-connect on your schema.
474
475 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
476
477 Old name for DBIC_TRACE
478
479 =head1 SEE ALSO
480
481 L<DBIx::Class::Storage::DBI> - reference storage implementation using
482 SQL::Abstract and DBI.
483
484 =head1 AUTHORS
485
486 Matt S. Trout <mst@shadowcatsystems.co.uk>
487
488 Andy Grundman <andy@hybridized.org>
489
490 =head1 LICENSE
491
492 You may distribute this code under the same terms as Perl itself.
493
494 =cut
495
496 1;