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