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