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