Merge 'bulk_create' into 'DBIx-Class-current'
[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/;
046ad905 10
046ad905 11__PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/);
12
4012acd8 13package # Hide from PAUSE
14 DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
15
16use overload '"' => sub {
17 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION'
18};
19
20sub new {
21 my $class = shift;
22 my $self = {};
23 return bless $self, $class;
24}
25
26package DBIx::Class::Storage;
27
046ad905 28=head1 NAME
29
30DBIx::Class::Storage - Generic Storage Handler
31
32=head1 DESCRIPTION
33
34A base implementation of common Storage methods. For specific
35information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.
36
37=head1 METHODS
38
39=head2 new
40
41Arguments: $schema
42
43Instantiates the Storage object.
44
45=cut
46
47sub 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
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
6500d50f 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.
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
252=cut
253
254sub txn_commit { die "Virtual method!" }
255
256=head2 txn_rollback
257
258Issues a rollback of the current transaction. A nested rollback will
259throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
260which allows the rollback to propagate to the outermost transaction.
261
262=cut
263
264sub txn_rollback { die "Virtual method!" }
265
266=head2 sql_maker
267
268Returns a C<sql_maker> object - normally an object of class
269C<DBIC::SQL::Abstract>.
270
271=cut
272
273sub sql_maker { die "Virtual method!" }
274
275=head2 debug
276
277Causes trace information to be emitted on the C<debugobj> object.
278(or C<STDERR> if C<debugobj> has not specifically been set).
279
280This is the equivalent to setting L</DBIC_TRACE> in your
281shell environment.
282
283=head2 debugfh
284
285Set or retrieve the filehandle used for trace/debug output. This should be
286an IO::Handle compatible ojbect (only the C<print> method is used. Initially
287set to be STDERR - although see information on the
288L<DBIC_TRACE> environment variable.
289
290=cut
291
292sub debugfh {
293 my $self = shift;
294
295 if ($self->debugobj->can('debugfh')) {
296 return $self->debugobj->debugfh(@_);
297 }
298}
299
300=head2 debugobj
301
302Sets or retrieves the object used for metric collection. Defaults to an instance
303of L<DBIx::Class::Storage::Statistics> that is compatible with the original
304method of using a coderef as a callback. See the aforementioned Statistics
305class for more information.
306
307=head2 debugcb
308
309Sets a callback to be executed each time a statement is run; takes a sub
310reference. Callback is executed as $sub->($op, $info) where $op is
311SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
312
313See L<debugobj> for a better way.
314
315=cut
316
317sub debugcb {
318 my $self = shift;
319
320 if ($self->debugobj->can('callback')) {
321 return $self->debugobj->callback(@_);
322 }
323}
324
325=head2 cursor
326
327The cursor class for this Storage object.
328
329=cut
330
331sub cursor { die "Virtual method!" }
332
333=head2 deploy
334
335Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
336Storage class). This would normally be called through
337L<DBIx::Class::Schema/deploy>.
338
339=cut
340
341sub deploy { die "Virtual method!" }
342
a3eaff0e 343=head2 connect_info
344
345The arguments of C<connect_info> are always a single array reference,
346and are Storage-handler specific.
347
348This is normally accessed via L<DBIx::Class::Schema/connection>, which
349encapsulates its argument list in an arrayref before calling
350C<connect_info> here.
351
352=cut
353
046ad905 354sub connect_info { die "Virtual method!" }
a3eaff0e 355
356=head2 select
357
358Handle a select statement.
359
360=cut
361
362sub select { die "Virtual method!" }
363
364=head2 insert
365
366Handle an insert statement.
367
368=cut
369
046ad905 370sub insert { die "Virtual method!" }
a3eaff0e 371
372=head2 update
373
374Handle an update statement.
375
376=cut
377
046ad905 378sub update { die "Virtual method!" }
a3eaff0e 379
380=head2 delete
381
382Handle a delete statement.
383
384=cut
385
046ad905 386sub delete { die "Virtual method!" }
a3eaff0e 387
388=head2 select_single
389
390Performs a select, fetch and return of data - handles a single row
391only.
392
393=cut
394
046ad905 395sub select_single { die "Virtual method!" }
a3eaff0e 396
397=head2 columns_info_for
398
c22c7625 399Returns metadata for the given source's columns. This
400is *deprecated*, and will be removed before 1.0. You should
401be specifying the metadata yourself if you need it.
a3eaff0e 402
403=cut
404
046ad905 405sub columns_info_for { die "Virtual method!" }
406
407=head1 ENVIRONMENT VARIABLES
408
409=head2 DBIC_TRACE
410
411If C<DBIC_TRACE> is set then trace information
412is produced (as when the L<debug> method is set).
413
414If the value is of the form C<1=/path/name> then the trace output is
415written to the file C</path/name>.
416
417This environment variable is checked when the storage object is first
418created (when you call connect on your schema). So, run-time changes
419to this environment variable will not take effect unless you also
420re-connect on your schema.
421
422=head2 DBIX_CLASS_STORAGE_DBI_DEBUG
423
424Old name for DBIC_TRACE
425
426=head1 AUTHORS
427
428Matt S. Trout <mst@shadowcatsystems.co.uk>
429
430Andy Grundman <andy@hybridized.org>
431
432=head1 LICENSE
433
434You may distribute this code under the same terms as Perl itself.
435
436=cut
437
a62cf8d4 4381;