make _determine_driver more reentrant
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage.pm
CommitLineData
4012acd8 1package DBIx::Class::Storage;
a62cf8d4 2
3use strict;
4use warnings;
5
046ad905 6use base qw/DBIx::Class/;
2ad62d97 7use mro 'c3';
046ad905 8
9use Scalar::Util qw/weaken/;
aaba9524 10use Carp::Clan qw/^DBIx::Class/;
942cd0c1 11use IO::File;
1bc193ac 12use DBIx::Class::Storage::TxnScopeGuard;
046ad905 13
046ad905 14__PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/);
e4eb8ee1 15__PACKAGE__->mk_group_accessors('inherited' => 'cursor_class');
16
17__PACKAGE__->cursor_class('DBIx::Class::Cursor');
18
19sub cursor { shift->cursor_class(@_); }
046ad905 20
4012acd8 21package # Hide from PAUSE
22 DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
23
24use overload '"' => sub {
25 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION'
26};
27
28sub new {
29 my $class = shift;
30 my $self = {};
31 return bless $self, $class;
32}
33
34package DBIx::Class::Storage;
35
046ad905 36=head1 NAME
37
38DBIx::Class::Storage - Generic Storage Handler
39
40=head1 DESCRIPTION
41
42A base implementation of common Storage methods. For specific
43information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.
44
45=head1 METHODS
46
47=head2 new
48
49Arguments: $schema
50
51Instantiates the Storage object.
52
53=cut
54
55sub new {
56 my ($self, $schema) = @_;
57
58 $self = ref $self if ref $self;
59
60 my $new = {};
61 bless $new, $self;
62
63 $new->set_schema($schema);
64 $new->debugobj(new DBIx::Class::Storage::Statistics());
65
70f39278 66 #my $fh;
046ad905 67
68 my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
69 || $ENV{DBIC_TRACE};
70
046ad905 71 $new->debug(1) if $debug_env;
72
73 $new;
74}
75
76=head2 set_schema
77
78Used to reset the schema class or object which owns this
79storage object, such as during L<DBIx::Class::Schema/clone>.
80
81=cut
82
83sub set_schema {
84 my ($self, $schema) = @_;
85 $self->schema($schema);
86 weaken($self->{schema}) if ref $self->{schema};
87}
88
89=head2 connected
90
91Returns true if we have an open storage connection, false
92if it is not (yet) open.
93
94=cut
95
a62cf8d4 96sub connected { die "Virtual method!" }
046ad905 97
98=head2 disconnect
99
100Closes any open storage connection unconditionally.
101
102=cut
103
104sub disconnect { die "Virtual method!" }
105
106=head2 ensure_connected
107
108Initiate a connection to the storage if one isn't already open.
109
110=cut
111
a62cf8d4 112sub ensure_connected { die "Virtual method!" }
046ad905 113
114=head2 throw_exception
115
116Throws an exception - croaks.
117
118=cut
119
120sub throw_exception {
121 my $self = shift;
122
123 $self->schema->throw_exception(@_) if $self->schema;
124 croak @_;
125}
a62cf8d4 126
4012acd8 127=head2 txn_do
a62cf8d4 128
4012acd8 129=over 4
a62cf8d4 130
4012acd8 131=item Arguments: C<$coderef>, @coderef_args?
a62cf8d4 132
4012acd8 133=item Return Value: The return value of $coderef
134
135=back
136
137Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
138returning its result (if any). If an exception is caught, a rollback is issued
139and the exception is rethrown. If the rollback fails, (i.e. throws an
140exception) an exception is thrown that includes a "Rollback failed" message.
141
142For 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
168In a nested transaction (calling txn_do() from within a txn_do() coderef) only
169the outermost transaction will issue a L</txn_commit>, and txn_do() can be
170called in void, scalar and list context and it will behave as expected.
171
05075aee 172Please note that all of the code in your coderef, including non-DBIx::Class
173code, is part of a transaction. This transaction may fail out halfway, or
174it may get partially double-executed (in the case that our DB connection
175failed halfway through the transaction, in which case we reconnect and
176restart the txn). Therefore it is best that any side-effects in your coderef
177are idempotent (that is, can be re-executed multiple times and get the
178same result), and that you check up on your side-effects in the case of
179transaction failure.
6500d50f 180
4012acd8 181=cut
182
183sub 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;
a62cf8d4 235}
236
046ad905 237=head2 txn_begin
238
239Starts a transaction.
240
241See the preferred L</txn_do> method, which allows for
242an entire code block to be executed transactionally.
243
244=cut
245
246sub txn_begin { die "Virtual method!" }
247
248=head2 txn_commit
249
250Issues a commit of the current transaction.
251
be01f1be 252It does I<not> perform an actual storage commit unless there's a DBIx::Class
253transaction currently in effect (i.e. you called L</txn_begin>).
254
046ad905 255=cut
256
257sub txn_commit { die "Virtual method!" }
258
259=head2 txn_rollback
260
261Issues a rollback of the current transaction. A nested rollback will
262throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
263which allows the rollback to propagate to the outermost transaction.
264
265=cut
266
267sub txn_rollback { die "Virtual method!" }
268
adb3554a 269=head2 svp_begin
270
360dc8a5 271Arguments: $savepoint_name?
adb3554a 272
360dc8a5 273Created a new savepoint using the name provided as argument. If no name
274is provided, a random name will be used.
adb3554a 275
276=cut
277
278sub svp_begin { die "Virtual method!" }
279
280=head2 svp_release
281
360dc8a5 282Arguments: $savepoint_name?
adb3554a 283
360dc8a5 284Release the savepoint provided as argument. If none is provided,
285release the savepoint created most recently. This will implicitly
286release all savepoints created after the one explicitly released as well.
adb3554a 287
288=cut
289
290sub svp_release { die "Virtual method!" }
291
292=head2 svp_rollback
293
360dc8a5 294Arguments: $savepoint_name?
adb3554a 295
360dc8a5 296Rollback to the savepoint provided as argument. If none is provided,
297rollback to the savepoint created most recently. This will implicitly
298release all savepoints created after the savepoint we rollback to.
adb3554a 299
300=cut
301
302sub svp_rollback { die "Virtual method!" }
303
dd018f09 304=for comment
3b7f3eac 305
6936e902 306=head2 txn_scope_guard
1bc193ac 307
6936e902 308An alternative way of transaction handling based on
309L<DBIx::Class::Storage::TxnScopeGuard>:
89028f42 310
6936e902 311 my $txn_guard = $storage->txn_scope_guard;
89028f42 312
313 $row->col1("val1");
314 $row->update;
315
6936e902 316 $txn_guard->commit;
89028f42 317
6936e902 318If an exception occurs, or the guard object otherwise leaves the scope
319before C<< $txn_guard->commit >> is called, the transaction will be rolled
320back by an explicit L</txn_rollback> call. In essence this is akin to
321using a L</txn_begin>/L</txn_commit> pair, without having to worry
322about calling L</txn_rollback> at the right places. Note that since there
323is no defined code closure, there will be no retries and other magic upon
324database disconnection. If you need such functionality see L</txn_do>.
1bc193ac 325
326=cut
327
328sub txn_scope_guard {
329 return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
330}
331
046ad905 332=head2 sql_maker
333
334Returns a C<sql_maker> object - normally an object of class
6f4ddea1 335C<DBIx::Class::SQLAHacks>.
046ad905 336
337=cut
338
339sub sql_maker { die "Virtual method!" }
340
341=head2 debug
342
343Causes trace information to be emitted on the C<debugobj> object.
344(or C<STDERR> if C<debugobj> has not specifically been set).
345
346This is the equivalent to setting L</DBIC_TRACE> in your
347shell environment.
348
349=head2 debugfh
350
351Set or retrieve the filehandle used for trace/debug output. This should be
352an IO::Handle compatible ojbect (only the C<print> method is used. Initially
353set to be STDERR - although see information on the
354L<DBIC_TRACE> environment variable.
355
356=cut
357
358sub debugfh {
359 my $self = shift;
360
361 if ($self->debugobj->can('debugfh')) {
362 return $self->debugobj->debugfh(@_);
363 }
364}
365
366=head2 debugobj
367
368Sets or retrieves the object used for metric collection. Defaults to an instance
369of L<DBIx::Class::Storage::Statistics> that is compatible with the original
370method of using a coderef as a callback. See the aforementioned Statistics
371class for more information.
372
373=head2 debugcb
374
375Sets a callback to be executed each time a statement is run; takes a sub
376reference. Callback is executed as $sub->($op, $info) where $op is
377SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
378
379See L<debugobj> for a better way.
380
381=cut
382
383sub debugcb {
384 my $self = shift;
385
386 if ($self->debugobj->can('callback')) {
387 return $self->debugobj->callback(@_);
388 }
389}
390
e4eb8ee1 391=head2 cursor_class
046ad905 392
393The cursor class for this Storage object.
394
395=cut
396
046ad905 397=head2 deploy
398
399Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
400Storage class). This would normally be called through
401L<DBIx::Class::Schema/deploy>.
402
403=cut
404
405sub deploy { die "Virtual method!" }
406
a3eaff0e 407=head2 connect_info
408
409The arguments of C<connect_info> are always a single array reference,
410and are Storage-handler specific.
411
412This is normally accessed via L<DBIx::Class::Schema/connection>, which
413encapsulates its argument list in an arrayref before calling
414C<connect_info> here.
415
416=cut
417
046ad905 418sub connect_info { die "Virtual method!" }
a3eaff0e 419
420=head2 select
421
422Handle a select statement.
423
424=cut
425
426sub select { die "Virtual method!" }
427
428=head2 insert
429
430Handle an insert statement.
431
432=cut
433
046ad905 434sub insert { die "Virtual method!" }
a3eaff0e 435
436=head2 update
437
438Handle an update statement.
439
440=cut
441
046ad905 442sub update { die "Virtual method!" }
a3eaff0e 443
444=head2 delete
445
446Handle a delete statement.
447
448=cut
449
046ad905 450sub delete { die "Virtual method!" }
a3eaff0e 451
452=head2 select_single
453
454Performs a select, fetch and return of data - handles a single row
455only.
456
457=cut
458
046ad905 459sub select_single { die "Virtual method!" }
a3eaff0e 460
461=head2 columns_info_for
462
c22c7625 463Returns metadata for the given source's columns. This
464is *deprecated*, and will be removed before 1.0. You should
465be specifying the metadata yourself if you need it.
a3eaff0e 466
467=cut
468
046ad905 469sub columns_info_for { die "Virtual method!" }
470
471=head1 ENVIRONMENT VARIABLES
472
473=head2 DBIC_TRACE
474
475If C<DBIC_TRACE> is set then trace information
476is produced (as when the L<debug> method is set).
477
478If the value is of the form C<1=/path/name> then the trace output is
479written to the file C</path/name>.
480
481This environment variable is checked when the storage object is first
482created (when you call connect on your schema). So, run-time changes
483to this environment variable will not take effect unless you also
484re-connect on your schema.
485
486=head2 DBIX_CLASS_STORAGE_DBI_DEBUG
487
488Old name for DBIC_TRACE
489
ace385bd 490=head1 SEE ALSO
491
2f0790c4 492L<DBIx::Class::Storage::DBI> - reference storage implementation using
493SQL::Abstract and DBI.
ace385bd 494
046ad905 495=head1 AUTHORS
496
497Matt S. Trout <mst@shadowcatsystems.co.uk>
498
499Andy Grundman <andy@hybridized.org>
500
501=head1 LICENSE
502
503You may distribute this code under the same terms as Perl itself.
504
505=cut
506
a62cf8d4 5071;