Fix the merge with txn_scope_guard() and put the necessary =cut in.
[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 =for comment
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;